pkg/gmredi/gmredi_init_varia.F

0c49347dc7 Alis*0001 #include "GMREDI_OPTIONS.h"
94a8024bbe Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
0c49347dc7 Alis*0005
8391062d12 Jean*0006 CBOP
e04376af63 Jean*0007 C     !ROUTINE: GMREDI_INIT_VARIA
8391062d12 Jean*0008 C     !INTERFACE:
e04376af63 Jean*0009       SUBROUTINE GMREDI_INIT_VARIA( myThid )
8391062d12 Jean*0010
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
e04376af63 Jean*0013 C     | SUBROUTINE GMREDI_INIT_VARIA
8391062d12 Jean*0014 C     | o Routine to initialize GM/Redi variables
                0015 C     *==========================================================*
                0016 C     \ev
f6de204bec Jean*0017
8391062d12 Jean*0018 C     !USES:
0c49347dc7 Alis*0019       IMPLICIT NONE
                0020
                0021 C     === Global variables ===
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "GRID.h"
                0026 #include "GMREDI.h"
8391062d12 Jean*0027 #include "GMREDI_TAVE.h"
0c49347dc7 Alis*0028
8391062d12 Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
                0030 C     myThid ::  my Thread Id number
0c49347dc7 Alis*0031       INTEGER myThid
8391062d12 Jean*0032 CEOP
0c49347dc7 Alis*0033
                0034 #ifdef ALLOW_GMREDI
8391062d12 Jean*0035 C     !LOCAL VARIABLES:
f42e64b3e7 Jean*0036       INTEGER i,j,k,bi,bj
0c49347dc7 Alis*0037
94a8024bbe Jean*0038 C--   Initialise again 3-D control variables (AD-compiler need to see this)
                0039 #if (defined ALLOW_KAPREDI_CONTROL && defined GM_READ_K3D_REDI )
                0040 C--   Initialize 3-D Isopycnal diffusivity in common block
                0041       DO bj = myByLo(myThid), myByHi(myThid)
                0042        DO bi = myBxLo(myThid), myBxHi(myThid)
                0043         DO k=1,Nr
                0044          DO j=1-OLy,sNy+OLy
                0045           DO i=1-OLx,sNx+OLx
                0046            GM_inpK3dRedi(i,j,k,bi,bj) = GM_isopycK
                0047      &                  *GM_isoFac1d(k)*GM_isoFac2d(i,j,bi,bj)
                0048           ENDDO
                0049          ENDDO
                0050         ENDDO
                0051        ENDDO
                0052       ENDDO
                0053 #endif /* ALLOW_KAPREDI_CONTROL and GM_READ_K3D_REDI */
                0054 #if (defined ALLOW_KAPGM_CONTROL && defined GM_READ_K3D_GM )
                0055 C--   Initialize 3-D Thickness diffusivity in common block
                0056       DO bj = myByLo(myThid), myByHi(myThid)
                0057        DO bi = myBxLo(myThid), myBxHi(myThid)
                0058         DO k=1,Nr
                0059          DO j=1-OLy,sNy+OLy
                0060           DO i=1-OLx,sNx+OLx
                0061            GM_inpK3dGM(i,j,k,bi,bj) = GM_background_K
                0062      &                  *GM_bolFac1d(k)*GM_bolFac2d(i,j,bi,bj)
                0063           ENDDO
                0064          ENDDO
                0065         ENDDO
                0066        ENDDO
                0067       ENDDO
                0068 #endif /* ALLOW_KAPGM_CONTROL and GM_READ_K3D_GM */
                0069
                0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071 #ifdef ALLOW_AUTODIFF
                0072 C- Note: To simplify dependency & avoid recomputations, when compiling
                0073 C        pkg/autodiff, we always call GMREDI_INIT_VARIA to initialise control
                0074 C        variables (as done above) without condition on useGMRedi.
                0075 C        Therefore, in this case, the "If useGMRedi" is added back here:
                0076       IF ( useGMRedi ) THEN
                0077 #endif
a4576c7cde Juli*0078 #ifdef GM_GEOM_VARIABLE_K
                0079 C     use AB2 time stepping
                0080        _BEGIN_MASTER( myThid )
                0081         GEOM_startAB = MIN( nIter0, 1 )
                0082        _END_MASTER( myThid )
                0083 #endif
94a8024bbe Jean*0084
                0085 #if (defined ALLOW_KAPREDI_CONTROL && defined GM_READ_K3D_REDI )
                0086 C--   Read (again) 3-D Isopycnal diffusivity from file
                0087       IF ( GM_K3dRediFile .NE. ' ' ) THEN
                0088        CALL READ_FLD_XYZ_RL( GM_K3dRediFile, ' ',
                0089      &                       GM_inpK3dRedi, 0, myThid )
                0090        CALL EXCH_XYZ_RL( GM_inpK3dRedi, myThid )
                0091       ENDIF
                0092 #endif /* ALLOW_KAPREDI_CONTROL and GM_READ_K3D_REDI */
                0093 #if (defined ALLOW_KAPGM_CONTROL && defined GM_READ_K3D_GM )
                0094 C--   Read (again) 3-D Thickness diffusivity from file
                0095       IF ( GM_K3dGMFile .NE. ' ' ) THEN
                0096        CALL READ_FLD_XYZ_RL( GM_K3dGMFile, ' ',
                0097      &                       GM_inpK3dGM, 0, myThid )
                0098        CALL EXCH_XYZ_RL( GM_inpK3dGM, myThid )
                0099       ENDIF
                0100 #endif /* ALLOW_KAPGM_CONTROL and GM_READ_K3D_GM */
                0101
0c49347dc7 Alis*0102       DO bj = myByLo(myThid), myByHi(myThid)
                0103        DO bi = myBxLo(myThid), myBxHi(myThid)
f42e64b3e7 Jean*0104
a4576c7cde Juli*0105 C     Initialize 3-D arrays in common blocks :
f42e64b3e7 Jean*0106         DO k=1,Nr
796b5e35f7 Jean*0107          DO j=1-OLy,sNy+OLy
                0108           DO i=1-OLx,sNx+OLx
b6b11b9b2f Patr*0109            Kwx(i,j,k,bi,bj) = 0. _d 0
                0110            Kwy(i,j,k,bi,bj) = 0. _d 0
                0111            Kwz(i,j,k,bi,bj) = 0. _d 0
796b5e35f7 Jean*0112            Kux(i,j,k,bi,bj) = 0. _d 0
                0113            Kvy(i,j,k,bi,bj) = 0. _d 0
f42e64b3e7 Jean*0114 #ifdef GM_EXTRA_DIAGONAL
b6b11b9b2f Patr*0115            Kuz(i,j,k,bi,bj) = 0. _d 0
                0116            Kvz(i,j,k,bi,bj) = 0. _d 0
f42e64b3e7 Jean*0117 #endif
                0118 #ifdef GM_BOLUS_ADVEC
b6b11b9b2f Patr*0119            GM_PsiX(i,j,k,bi,bj) = 0. _d 0
                0120            GM_PsiY(i,j,k,bi,bj) = 0. _d 0
f42e64b3e7 Jean*0121 #endif
f59d76b0dd Ed D*0122 #ifdef ALLOW_GM_LEITH_QG
                0123            GM_LeithQG_K(i,j,k,bi,bj) = 0. _d 0
f42e64b3e7 Jean*0124 #endif
05118ac017 Jean*0125 #ifdef GM_BATES_K3D
                0126            GM_BatesK3d(i,j,k,bi,bj) = 0. _d 0
0d1e4b948d Mich*0127 #endif
a4576c7cde Juli*0128 #ifdef GM_GEOM_VARIABLE_K
                0129            GEOM_K3d(i,j,k,bi,bj) = 0. _d 0
                0130 #endif
f42e64b3e7 Jean*0131           ENDDO
                0132          ENDDO
                0133         ENDDO
a4576c7cde Juli*0134 C     Initialize 2-D arrays in common blocks :
                0135         DO j=1-OLy,sNy+OLy
                0136          DO i=1-OLx,sNx+OLx
                0137 #ifdef GM_VISBECK_VARIABLE_K
                0138            VisbeckK(i,j,bi,bj) = 0. _d 0
                0139 #endif
                0140 #ifdef GM_GEOM_VARIABLE_K
                0141            GEOM_EKE(i,j,bi,bj) = GEOM_ini_EKE * maskInC(i,j,bi,bj)
                0142            GEOM_gEKE_Nm1(i,j,bi,bj) = 0. _d 0
                0143 #endif
                0144          ENDDO
                0145         ENDDO
f42e64b3e7 Jean*0146
                0147 #ifdef ALLOW_TIMEAVE
                0148 C     Initialize averages to zero
0ac82346d7 Jean*0149         CALL TIMEAVE_RESET(GM_Kwx_T,Nr, bi,bj,myThid)
                0150         CALL TIMEAVE_RESET(GM_Kwy_T,Nr, bi,bj,myThid)
                0151         CALL TIMEAVE_RESET(GM_Kwz_T,Nr, bi,bj,myThid)
8d8488bf10 Jean*0152         GM_timeAve(bi,bj) = 0. _d 0
0c49347dc7 Alis*0153 #ifdef GM_VISBECK_VARIABLE_K
0ac82346d7 Jean*0154         CALL TIMEAVE_RESET(Visbeck_K_T, 1, bi,bj,myThid)
0c49347dc7 Alis*0155 #endif
f42e64b3e7 Jean*0156 #ifdef GM_BOLUS_ADVEC
                0157         CALL TIMEAVE_RESET(GM_PsiXtave,Nr, bi,bj,myThid)
                0158         CALL TIMEAVE_RESET(GM_PsiYtave,Nr, bi,bj,myThid)
                0159 #endif
0ac82346d7 Jean*0160 #endif /* ALLOW_TIMEAVE */
0c49347dc7 Alis*0161
f42e64b3e7 Jean*0162 C- end bi,bj loops
                0163        ENDDO
                0164       ENDDO
f6de204bec Jean*0165
94a8024bbe Jean*0166 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
f6de204bec Jean*0167 C--   write GM scaling factors to file:
                0168       IF ( GM_iso1dFile .NE. ' ' ) THEN
                0169         CALL WRITE_GLVEC_RS( 'GM_isoFac1d', ' ', GM_isoFac1d,
                0170      I                        Nr, -1, myThid )
                0171       ENDIF
                0172       IF ( GM_bol1dFile .NE. ' ' ) THEN
                0173         CALL WRITE_GLVEC_RS( 'GM_bolFac1d', ' ', GM_bolFac1d,
                0174      I                        Nr, -1, myThid )
                0175       ENDIF
                0176       IF ( GM_iso2dFile .NE. ' ' ) THEN
                0177         CALL WRITE_FLD_XY_RS( 'GM_isoFac2d',' ',GM_isoFac2d,-1,myThid )
                0178       ENDIF
                0179       IF ( GM_bol2dFile .NE. ' ' ) THEN
                0180         CALL WRITE_FLD_XY_RS( 'GM_bolFac2d',' ',GM_bolFac2d,-1,myThid )
                0181       ENDIF
0c49347dc7 Alis*0182
a4576c7cde Juli*0183 #if ( defined GM_BATES_K3D || defined GM_GEOM_VARIABLE_K )
                0184       IF ( .NOT.( startTime.EQ.baseTime .AND. nIter0.EQ.0
                0185      &            .AND. pickupSuff.EQ.' ' )
                0186      &     .AND.( GM_useBatesK3d .OR. GM_useGEOM ) ) THEN
                0187         CALL GMREDI_READ_PICKUP( nIter0, myThid )
5a6ef5c2b4 Mich*0188       ENDIF
                0189 #endif
f183cca6ba Davi*0190
05118ac017 Jean*0191 #ifdef GM_BATES_K3D
a4576c7cde Juli*0192 C     This is put here, but really should be in gmredi_init_fixed.F. The
                0193 C     problem is that fCori, fCoriCos, etc are not initialized when
                0194 C     gmredi_init_fixed.F is called. To be fixed.
f183cca6ba Davi*0195 C     Computing beta = df/dy
                0196       IF ( selectCoriMap.EQ.1 ) THEN
                0197        DO bj = myByLo(myThid), myByHi(myThid)
                0198         DO bi = myBxLo(myThid), myBxHi(myThid)
796b5e35f7 Jean*0199          DO j=1-OLy,sNy+OLy
                0200           DO i=1-OLx,sNx+OLx
f183cca6ba Davi*0201            gradf(i,j,bi,bj) =  beta
                0202           ENDDO
                0203          ENDDO
                0204         ENDDO
                0205        ENDDO
                0206       ELSEIF ( selectCoriMap.EQ.2 ) THEN
                0207        DO bj = myByLo(myThid), myByHi(myThid)
                0208         DO bi = myBxLo(myThid), myBxHi(myThid)
796b5e35f7 Jean*0209          DO j=1-OLy,sNy+OLy
                0210           DO i=1-OLx,sNx+OLx
f183cca6ba Davi*0211            gradf(i,j,bi,bj) = recip_rSphere*fCoriCos(i,j,bi,bj)
                0212           ENDDO
                0213          ENDDO
                0214         ENDDO
                0215        ENDDO
                0216       ELSE
                0217        DO bj = myByLo(myThid), myByHi(myThid)
                0218         DO bi = myBxLo(myThid), myBxHi(myThid)
796b5e35f7 Jean*0219          DO j=1-OLy+1,sNy+OLy-1
                0220           DO i=1-OLx+1,sNx+OLx-1
f183cca6ba Davi*0221            gradf(i,j,bi,bj)  =  .5 _d 0*angleSinC(i,j,bi,bj)*(
                0222      &    (fCori(i+1,j,bi,bj)-fCori(i  ,j,bi,bj))*recip_dxC(i+1,j,bi,bj)
                0223      &   +(fCori(i  ,j,bi,bj)-fCori(i-1,j,bi,bj))*recip_dxC(i,j,bi,bj) )
                0224      &                       +  .5 _d 0*angleCosC(i,j,bi,bj)*(
                0225      &    (fCori(i,j+1,bi,bj)-fCori(i,j  ,bi,bj))*recip_dyC(i,j+1,bi,bj)
                0226      &   +(fCori(i,j  ,bi,bj)-fCori(i,j-1,bi,bj))*recip_dyC(i,j,bi,bj) )
                0227            gradf(i,j,bi,bj)=max(1. _d -18, gradf(i,j,bi,bj) )
                0228           ENDDO
                0229          ENDDO
                0230         ENDDO
                0231        ENDDO
                0232       ENDIF
                0233       CALL EXCH_XY_RL( gradf, myThid)
94a8024bbe Jean*0234 #endif /* GM_BATES_K3D */
                0235
                0236 #ifdef ALLOW_AUTODIFF
                0237       ENDIF
f183cca6ba Davi*0238 #endif
94a8024bbe Jean*0239 #endif /* ALLOW_GMREDI */
f183cca6ba Davi*0240
8391062d12 Jean*0241       RETURN
                0242       END