hs94.1x64x5/code/ini_theta.F

1525958bfa Jean*0001 #include "PACKAGES_CONFIG.h"
42c525bfb4 Alis*0002 #include "CPP_OPTIONS.h"
                0003
1525958bfa Jean*0004 CBOP
                0005 C     !ROUTINE: INI_THETA
                0006 C     !INTERFACE:
42c525bfb4 Alis*0007       SUBROUTINE INI_THETA( myThid )
1525958bfa Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
b5c623e9ce Jean*0010 C     | SUBROUTINE INI_THETA
                0011 C     | o Set model initial temperature field.
1525958bfa Jean*0012 C     *==========================================================*
b5c623e9ce Jean*0013 C     | There are several options for setting the initial
                0014 C     | temperature file
                0015 C     |  1. Inline code
                0016 C     |  2. Vertical profile ( uniform T in X and Y )
                0017 C     |  3. Three-dimensional data from a file. For example from
                0018 C     |     Levitus or from a checkpoint file from a previous
                0019 C     |     integration.
                0020 C     | In addition to setting the temperature field we also
                0021 C     | set the initial temperature tendency term here.
1525958bfa Jean*0022 C     *==========================================================*
                0023 C     \ev
                0024
                0025 C     !USES:
42c525bfb4 Alis*0026       IMPLICIT NONE
                0027
                0028 C     === Global variables ===
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032 #include "GRID.h"
                0033 #include "DYNVARS.h"
                0034
1525958bfa Jean*0035 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0036 C     == Routine arguments ==
                0037 C     myThid -  Number of this instance of INI_THETA
                0038       INTEGER myThid
                0039
1525958bfa Jean*0040 C     == Functions ==
b5c623e9ce Jean*0041 c     real*8  PORT_RAND
                0042 c     real*8  seed
1525958bfa Jean*0043
                0044 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0045 C     == Local variables ==
                0046 C     bi,bj  - Loop counters
                0047 C     I,J,K
                0048       INTEGER bi, bj
                0049       INTEGER I, J, K, localWarnings
                0050       _RL     term1,term2,thetaLim,thetaEq
                0051       CHARACTER*(MAX_LEN_MBUF) msgBuf
1525958bfa Jean*0052 CEOP
42c525bfb4 Alis*0053
1525958bfa Jean*0054       J = 99+myBxLo(myThid)+nPx*myByLo(myThid)
                0055 c     CALL SRAND( J )
                0056 c     seed = j
                0057
42c525bfb4 Alis*0058       IF ( hydrogThetaFile .EQ. ' ' ) THEN
                0059 C--    Initialise temperature field to Held & Saurez equilibrium theta
                0060        DO bj = myByLo(myThid), myByHi(myThid)
                0061         DO bi = myBxLo(myThid), myBxHi(myThid)
                0062          DO K=1,Nr
1525958bfa Jean*0063           thetaLim = 200. _d 0/((rC(K)/atm_po)**atm_kappa)
42c525bfb4 Alis*0064           DO J=1,sNy
                0065            DO I=1,sNx
1525958bfa Jean*0066             term1=60. _d 0*(sin(yC(I,J,bi,bj)*deg2rad)**2)
                0067             term2=10. _d 0*log((rC(K)/atm_po))
                0068      &              *(cos(yC(I,J,bi,bj)*deg2rad)**2)
                0069             thetaEq=315. _d 0-term1-term2
42c525bfb4 Alis*0070             theta(I,J,K,bi,bj) = MAX( thetaLim, thetaEq )
1525958bfa Jean*0071 c    &                          + 0.01*(RAND()-0.5)
                0072 c    &                          + 0.01*(PORT_RAND(seed)-0.5)
                0073 c           theta(I,J,K,bi,bj) = tRef(K)
42c525bfb4 Alis*0074            ENDDO
                0075           ENDDO
                0076          ENDDO
1525958bfa Jean*0077 #ifdef ALLOW_ZONAL_FILT
                0078 C--   Zonal FFT filter initial conditions
                0079          IF (useZONAL_FILT) THEN
                0080           CALL ZONAL_FILTER(
b5c623e9ce Jean*0081      U                       theta(1-OLx,1-OLy,1,bi,bj),
                0082      I                       hFacC(1-OLx,1-OLy,1,bi,bj),
                0083      I                       1, sNy, Nr, bi, bj, 1, myThid )
1525958bfa Jean*0084          ENDIF
                0085 #endif /* ALLOW_ZONAL_FILT */
42c525bfb4 Alis*0086         ENDDO
                0087        ENDDO
                0088       ELSE
                0089        CALL READ_FLD_XYZ_RL( hydrogThetaFile, ' ', theta, 0, myThid )
                0090       ENDIF
1525958bfa Jean*0091 C--   Apply mask and test consistency
42c525bfb4 Alis*0092       localWarnings=0
                0093       DO bj = myByLo(myThid), myByHi(myThid)
                0094        DO bi = myBxLo(myThid), myBxHi(myThid)
                0095         DO K=1,Nr
1525958bfa Jean*0096          DO J=1-Oly,sNy+Oly
                0097           DO I=1-Olx,sNx+Olx
                0098            IF (maskC(I,J,K,bi,bj).EQ.0.) theta(I,J,K,bi,bj) = 0.
42c525bfb4 Alis*0099           ENDDO
                0100          ENDDO
1525958bfa Jean*0101          IF ( tRef(k).NE.0. ) THEN
                0102           DO J=1,sNy
                0103            DO I=1,sNx
                0104             IF (  maskC(I,J,K,bi,bj).NE.0.
                0105      &      .AND. theta(I,J,K,bi,bj).EQ.0. ) THEN
                0106               localWarnings=localWarnings+1
                0107             ENDIF
                0108            ENDDO
                0109           ENDDO
                0110          ENDIF
42c525bfb4 Alis*0111         ENDDO
                0112        ENDDO
                0113       ENDDO
                0114       IF (localWarnings.NE.0) THEN
                0115        WRITE(msgBuf,'(A,A)')
                0116      &  'S/R INI_THETA: theta = 0 identically. If this is intentional',
                0117      &  'you will need to edit ini_theta.F to avoid this safety check'
                0118        CALL PRINT_ERROR( msgBuf , myThid)
                0119        STOP 'ABNORMAL END: S/R INI_THETA'
                0120       ENDIF
1525958bfa Jean*0121
12ffad7671 Jean*0122       _EXCH_XYZ_RL(theta , myThid )
42c525bfb4 Alis*0123
b5c623e9ce Jean*0124       IF (debugMode) THEN
                0125         CALL PLOT_FIELD_XYZRL( theta, 'Initial Temperature' ,
                0126      &                         Nr, 1, myThid )
                0127       ENDIF
42c525bfb4 Alis*0128
                0129       RETURN
                0130       END