advect_xy/code/ini_theta.F

5273e7d26a Alis*0001 #include "CPP_OPTIONS.h"
                0002
1525958bfa Jean*0003 CBOP
                0004 C     !ROUTINE: INI_THETA
                0005 C     !INTERFACE:
5273e7d26a Alis*0006       SUBROUTINE INI_THETA( myThid )
1525958bfa Jean*0007 C     !DESCRIPTION: \bv
                0008 C     *==========================================================*
46fb26357b Jean*0009 C     | SUBROUTINE INI_THETA
                0010 C     | o Set model initial temperature field.
1525958bfa Jean*0011 C     *==========================================================*
46fb26357b Jean*0012 C     | There are several options for setting the initial
                0013 C     | temperature file
                0014 C     |  1. Inline code
                0015 C     |  2. Vertical profile ( uniform T in X and Y )
                0016 C     |  3. Three-dimensional data from a file. For example from
                0017 C     |     Levitus or from a checkpoint file from a previous
                0018 C     |     integration.
                0019 C     | In addition to setting the temperature field we also
                0020 C     | set the initial temperature tendency term here.
1525958bfa Jean*0021 C     *==========================================================*
                0022 C     \ev
5273e7d26a Alis*0023
1525958bfa Jean*0024 C     !USES:
                0025       IMPLICIT NONE
5273e7d26a Alis*0026 C     === Global variables ===
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #include "GRID.h"
                0031 #include "DYNVARS.h"
                0032
1525958bfa Jean*0033 C     !INPUT/OUTPUT PARAMETERS:
5273e7d26a Alis*0034 C     == Routine arguments ==
46fb26357b Jean*0035 C     myThid :: Number of this instance of INI_THETA
5273e7d26a Alis*0036       INTEGER myThid
                0037
1525958bfa Jean*0038 C     !LOCAL VARIABLES:
5273e7d26a Alis*0039 C     == Local variables ==
46fb26357b Jean*0040 C     bi,bj  :: Tile indices
                0041 C     i,j,k  :: Loop counters
                0042 C     rD     :: Radial displacement of point i,j
5273e7d26a Alis*0043       INTEGER bi, bj
46fb26357b Jean*0044       INTEGER i, j, k, localWarnings
1525958bfa Jean*0045       _RL     Tfreezing
                0046       _RL     rD
5273e7d26a Alis*0047       CHARACTER*(MAX_LEN_MBUF) msgBuf
1525958bfa Jean*0048 CEOP
5273e7d26a Alis*0049
1525958bfa Jean*0050 C--   Initialise temperature field to the vertical reference profile
                0051       DO bj = myByLo(myThid), myByHi(myThid)
                0052        DO bi = myBxLo(myThid), myBxHi(myThid)
46fb26357b Jean*0053         DO k=1,Nr
                0054          DO j=1-Oly,sNy+Oly
                0055           DO i=1-Olx,sNx+Olx
                0056            theta(i,j,k,bi,bj) = tRef(k)
1525958bfa Jean*0057           ENDDO
                0058          ENDDO
46fb26357b Jean*0059 C=== Set-up specific modification starts here ===
5273e7d26a Alis*0060 C--    Initialise temperature field to a circular patch.
46fb26357b Jean*0061          DO j=1,sNy
                0062           DO i=1,sNx
                0063             rD = SQRT( ( xC(i,j,bi,bj) - 40. _d 3 )**2
                0064      &                +( yC(i,j,bi,bj) - 40. _d 3 )**2
                0065      &                +( rC(k) + 50. _d 3 )**2
                0066      &               )
                0067             theta(i,j,k,bi,bj) = EXP( -0.5 _d 0*( rD/20. _d 3 )**2 )
5273e7d26a Alis*0068           ENDDO
                0069          ENDDO
46fb26357b Jean*0070 C=== Set-up specific modification ends here  ===
5273e7d26a Alis*0071         ENDDO
                0072        ENDDO
1525958bfa Jean*0073       ENDDO
46fb26357b Jean*0074 C=== Set-up specific modification starts here ===
                0075       _EXCH_XYZ_RL( theta, myThid )
                0076 C=== Set-up specific modification ends here  ===
1525958bfa Jean*0077
                0078       IF ( hydrogThetaFile .NE. ' ' ) THEN
46fb26357b Jean*0079         CALL READ_FLD_XYZ_RL( hydrogThetaFile, ' ', theta, 0, myThid )
                0080         _EXCH_XYZ_RL(theta,myThid)
5273e7d26a Alis*0081       ENDIF
1525958bfa Jean*0082
                0083 C--   Apply mask and test consistency
5273e7d26a Alis*0084       localWarnings=0
                0085       DO bj = myByLo(myThid), myByHi(myThid)
                0086        DO bi = myBxLo(myThid), myBxHi(myThid)
46fb26357b Jean*0087         DO k=1,Nr
                0088          IF ( maskIniTemp ) THEN
                0089           DO j=1-Oly,sNy+Oly
                0090            DO i=1-Olx,sNx+Olx
                0091             IF (maskC(i,j,k,bi,bj).EQ.0.) theta(i,j,k,bi,bj) = 0.
                0092            ENDDO
5273e7d26a Alis*0093           ENDDO
46fb26357b Jean*0094          ENDIF
1525958bfa Jean*0095          IF ( tRef(k).NE.0. ) THEN
46fb26357b Jean*0096           DO j=1,sNy
                0097            DO i=1,sNx
                0098             IF (  maskC(i,j,k,bi,bj).NE.0.
                0099      &      .AND. theta(i,j,k,bi,bj).EQ.0. ) THEN
1525958bfa Jean*0100               localWarnings=localWarnings+1
                0101             ENDIF
                0102            ENDDO
                0103           ENDDO
                0104          ENDIF
5273e7d26a Alis*0105         ENDDO
                0106        ENDDO
                0107       ENDDO
                0108       IF (localWarnings.NE.0) THEN
46fb26357b Jean*0109        IF ( checkIniTemp ) THEN
                0110         WRITE(msgBuf,'(A,I10,A)')
                0111      &   ' INI_THETA: found', localWarnings,
                0112      &   ' wet grid-pts with theta=0 identically.'
                0113         CALL PRINT_ERROR( msgBuf , myThid)
                0114         WRITE(msgBuf,'(A,A)')
                0115      &  ' If this is intentional, you need to',
                0116      &  ' set checkIniTemp=.false. in "data", namelist PARM05'
                0117         CALL PRINT_ERROR( msgBuf , myThid)
                0118         STOP 'ABNORMAL END: S/R INI_THETA'
                0119        ELSE
                0120         WRITE(msgBuf,'(A,I10,A)')
                0121      &   '** WARNINGS ** INI_THETA: found', localWarnings,
                0122      &   ' wet grid-pts with theta=0 identically.'
                0123         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0124      &                      SQUEEZE_RIGHT, myThid )
                0125        ENDIF
5273e7d26a Alis*0126       ENDIF
                0127
1525958bfa Jean*0128 C--   Check that there are no values of temperature below freezing point.
                0129       Tfreezing=-1.9 _d 0
                0130       IF ( allowFreezing ) THEN
                0131        DO bj = myByLo(myThid), myByHi(myThid)
                0132         DO bi = myBxLo(myThid), myBxHi(myThid)
46fb26357b Jean*0133          DO k=1,Nr
                0134           DO j=1-Oly,sNy+Oly
                0135            DO i=1-Olx,sNx+Olx
                0136             IF (theta(i,j,k,bi,bj) .LT. Tfreezing) THEN
                0137                theta(i,j,k,bi,bj) = Tfreezing
1525958bfa Jean*0138             ENDIF
                0139            ENDDO
                0140           ENDDO
                0141          ENDDO
                0142         ENDDO
                0143        ENDDO
                0144       ENDIF
                0145
46fb26357b Jean*0146       IF (debugMode) THEN
                0147         CALL PLOT_FIELD_XYZRL( theta, 'Initial Temperature',
                0148      &                         Nr, 1, myThid )
                0149       ENDIF
5273e7d26a Alis*0150
                0151       RETURN
                0152       END