model/src/ini_theta.F

cc6ab98535 Jean*0001 #include "PACKAGES_CONFIG.h"
1dbaea09ee Chri*0002 #include "CPP_OPTIONS.h"
924557e60a Chri*0003
9366854e02 Chri*0004 CBOP
                0005 C     !ROUTINE: INI_THETA
                0006 C     !INTERFACE:
924557e60a Chri*0007       SUBROUTINE INI_THETA( myThid )
7c20dc45c1 Jean*0008
9366854e02 Chri*0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
cc6ab98535 Jean*0011 C     | SUBROUTINE INI_THETA
                0012 C     | o Set model initial temperature field.
9366854e02 Chri*0013 C     *==========================================================*
cc6ab98535 Jean*0014 C     | There are several options for setting the initial
                0015 C     | temperature file
                0016 C     |  1. Inline code
                0017 C     |  2. Vertical profile ( uniform T in X and Y )
                0018 C     |  3. Three-dimensional data from a file. For example from
                0019 C     |     Levitus or from a checkpoint file from a previous
                0020 C     |     integration.
                0021 C     | In addition to setting the temperature field we also
                0022 C     | set the initial temperature tendency term here.
9366854e02 Chri*0023 C     *==========================================================*
                0024 C     \ev
924557e60a Chri*0025
9366854e02 Chri*0026 C     !USES:
                0027       IMPLICIT NONE
924557e60a Chri*0028 C     === Global variables ===
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032 #include "GRID.h"
                0033 #include "DYNVARS.h"
5f4df5533c Ed H*0034 #ifdef ALLOW_MNC
                0035 #include "MNC_PARAMS.h"
                0036 #endif
924557e60a Chri*0037
9366854e02 Chri*0038 C     !INPUT/OUTPUT PARAMETERS:
924557e60a Chri*0039 C     == Routine arguments ==
cc6ab98535 Jean*0040 C     myThid :: Number of this instance of INI_THETA
924557e60a Chri*0041       INTEGER myThid
                0042
9366854e02 Chri*0043 C     !LOCAL VARIABLES:
924557e60a Chri*0044 C     == Local variables ==
cc6ab98535 Jean*0045 C     bi,bj  :: Tile indices
4c5bb1c88e Jean*0046 C     i,j,k  :: Loop counters
924557e60a Chri*0047       INTEGER bi, bj
4c5bb1c88e Jean*0048       INTEGER i, j, k, localWarnings
459592f6e5 Jean*0049       _RL     Tfreezing
505bea2b9c Alis*0050       CHARACTER*(MAX_LEN_MBUF) msgBuf
9366854e02 Chri*0051 CEOP
924557e60a Chri*0052
aea29c8517 Alis*0053 C--   Initialise temperature field to the vertical reference profile
                0054       DO bj = myByLo(myThid), myByHi(myThid)
                0055        DO bi = myBxLo(myThid), myBxHi(myThid)
4c5bb1c88e Jean*0056         DO k=1,Nr
15c7c223de Jean*0057          DO j=1-OLy,sNy+OLy
                0058           DO i=1-OLx,sNx+OLx
4c5bb1c88e Jean*0059            theta(i,j,k,bi,bj) = tRef(k)
924557e60a Chri*0060           ENDDO
                0061          ENDDO
                0062         ENDDO
                0063        ENDDO
aea29c8517 Alis*0064       ENDDO
                0065
                0066       IF ( hydrogThetaFile .NE. ' ' ) THEN
5f4df5533c Ed H*0067 #ifdef ALLOW_MNC
cc6ab98535 Jean*0068         IF ( useMNC.AND.mnc_read_theta ) THEN
5f4df5533c Ed H*0069           CALL MNC_FILE_CLOSE_ALL_MATCHING(hydrogThetaFile, myThid)
                0070           CALL MNC_CW_SET_UDIM(hydrogThetaFile, 1, myThid)
                0071           CALL MNC_CW_SET_CITER(hydrogThetaFile, 2, -1, -1, -1, myThid)
                0072           CALL MNC_CW_SET_UDIM(hydrogThetaFile, 1, myThid)
                0073           CALL MNC_CW_RL_R('D',hydrogThetaFile,0,0,'Temp',theta,myThid)
                0074           CALL MNC_FILE_CLOSE_ALL_MATCHING(hydrogThetaFile, myThid)
                0075         ELSE
                0076 #endif /*  ALLOW_MNC  */
                0077           CALL READ_FLD_XYZ_RL( hydrogThetaFile, ' ', theta, 0, myThid )
                0078 #ifdef ALLOW_MNC
                0079         ENDIF
                0080 #endif /*  ALLOW_MNC  */
3365bdc872 Jean*0081         _EXCH_XYZ_RL(theta,myThid)
c1dd0647a3 Chri*0082       ENDIF
aea29c8517 Alis*0083
9d36aec500 Dimi*0084 C--   Apply mask and test consistency
505bea2b9c Alis*0085       localWarnings=0
924557e60a Chri*0086       DO bj = myByLo(myThid), myByHi(myThid)
                0087        DO bi = myBxLo(myThid), myBxHi(myThid)
4c5bb1c88e Jean*0088         DO k=1,Nr
                0089          IF ( maskIniTemp ) THEN
15c7c223de Jean*0090           DO j=1-OLy,sNy+OLy
                0091            DO i=1-OLx,sNx+OLx
4c5bb1c88e Jean*0092             IF (maskC(i,j,k,bi,bj).EQ.0.) theta(i,j,k,bi,bj) = 0.
                0093            ENDDO
924557e60a Chri*0094           ENDDO
4c5bb1c88e Jean*0095          ENDIF
459592f6e5 Jean*0096          IF ( tRef(k).NE.0. ) THEN
4c5bb1c88e Jean*0097           DO j=1,sNy
                0098            DO i=1,sNx
                0099             IF (  maskC(i,j,k,bi,bj).NE.0.
                0100      &      .AND. theta(i,j,k,bi,bj).EQ.0. ) THEN
459592f6e5 Jean*0101               localWarnings=localWarnings+1
                0102             ENDIF
                0103            ENDDO
                0104           ENDDO
                0105          ENDIF
924557e60a Chri*0106         ENDDO
                0107        ENDDO
                0108       ENDDO
505bea2b9c Alis*0109       IF (localWarnings.NE.0) THEN
4c5bb1c88e Jean*0110        IF ( checkIniTemp ) THEN
                0111         WRITE(msgBuf,'(A,I10,A)')
                0112      &   ' INI_THETA: found', localWarnings,
                0113      &   ' wet grid-pts with theta=0 identically.'
                0114         CALL PRINT_ERROR( msgBuf , myThid)
                0115         WRITE(msgBuf,'(A,A)')
                0116      &  ' If this is intentional, you need to',
15c7c223de Jean*0117      &  ' set checkIniTemp=.FALSE. in "data", namelist PARM05'
4c5bb1c88e Jean*0118         CALL PRINT_ERROR( msgBuf , myThid)
                0119         STOP 'ABNORMAL END: S/R INI_THETA'
                0120        ELSE
                0121         WRITE(msgBuf,'(A,I10,A)')
                0122      &   '** WARNINGS ** INI_THETA: found', localWarnings,
                0123      &   ' wet grid-pts with theta=0 identically.'
                0124         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0125      &                      SQUEEZE_RIGHT, myThid )
                0126        ENDIF
505bea2b9c Alis*0127       ENDIF
1d73358b0d Chri*0128
9d36aec500 Dimi*0129 C--   Check that there are no values of temperature below freezing point.
15c7c223de Jean*0130       IF ( checkIniTemp .AND. allowFreezing ) THEN
                0131        Tfreezing=-1.9 _d 0
9d36aec500 Dimi*0132        DO bj = myByLo(myThid), myByHi(myThid)
                0133         DO bi = myBxLo(myThid), myBxHi(myThid)
4c5bb1c88e Jean*0134          DO k=1,Nr
15c7c223de Jean*0135           DO j=1-OLy,sNy+OLy
                0136            DO i=1-OLx,sNx+OLx
4c5bb1c88e Jean*0137             IF (theta(i,j,k,bi,bj) .LT. Tfreezing) THEN
                0138                theta(i,j,k,bi,bj) = Tfreezing
9d36aec500 Dimi*0139             ENDIF
                0140            ENDDO
                0141           ENDDO
                0142          ENDDO
                0143         ENDDO
                0144        ENDDO
15c7c223de Jean*0145 c     ELSEIF ( allowFreezing ) THEN
                0146 c      CALL FREEZE_SURFACE( startTime, nIter0, myThid )
9d36aec500 Dimi*0147       ENDIF
                0148
522c728681 Jean*0149       IF ( plotLevel.GE.debLevC ) THEN
cc6ab98535 Jean*0150         CALL PLOT_FIELD_XYZRL( theta, 'Initial Temperature',
                0151      &                         Nr, 1, myThid )
                0152       ENDIF
1d73358b0d Chri*0153
924557e60a Chri*0154       RETURN
                0155       END