File indexing completed on 2024-02-29 06:10:25 UTC
view on githubraw file Latest commit a4576c7c on 2024-02-28 22:55:11 UTC
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
e04376af63 Jean*0007
8391062d12 Jean*0008
e04376af63 Jean*0009 SUBROUTINE GMREDI_INIT_VARIA( myThid )
8391062d12 Jean*0010
0011
0012
e04376af63 Jean*0013
8391062d12 Jean*0014
0015
0016
f6de204bec Jean*0017
8391062d12 Jean*0018
0c49347dc7 Alis*0019 IMPLICIT NONE
0020
0021
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
0030
0c49347dc7 Alis*0031 INTEGER myThid
8391062d12 Jean*0032
0c49347dc7 Alis*0033
0034 #ifdef ALLOW_GMREDI
8391062d12 Jean*0035
f42e64b3e7 Jean*0036 INTEGER i,j,k,bi,bj
0c49347dc7 Alis*0037
94a8024bbe Jean*0038
0039 #if (defined ALLOW_KAPREDI_CONTROL && defined GM_READ_K3D_REDI )
0040
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
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
0071 #ifdef ALLOW_AUTODIFF
0072
0073
0074
0075
0076 IF ( useGMRedi ) THEN
0077 #endif
a4576c7cde Juli*0078 #ifdef GM_GEOM_VARIABLE_K
0079
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
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
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
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
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
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
0163 ENDDO
0164 ENDDO
f6de204bec Jean*0165
94a8024bbe Jean*0166
f6de204bec Jean*0167
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
0193
0194
f183cca6ba Davi*0195
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