File indexing completed on 2023-09-03 05:10:24 UTC
view on githubraw file Latest commit 74487008 on 2023-09-03 01:50:18 UTC
d7ce0d34f8 Jean*0001 #include "GAD_OPTIONS.h"
7448700841 Mart*0002 #ifdef ALLOW_PTRACERS
0003 # include "PTRACERS_OPTIONS.h"
0004 #endif
1574069d50 Mart*0005 #ifdef ALLOW_AUTODIFF
0006 # include "AUTODIFF_OPTIONS.h"
0007 #endif
d7ce0d34f8 Jean*0008
0009
0010
0011
0012
0013 SUBROUTINE GAD_SOM_ADV_X(
0014 I bi,bj,k, limiter,
b79a2b44f2 Jean*0015 I overlapOnly, interiorOnly,
0016 I N_edge, S_edge, E_edge, W_edge,
72de869c1b Jean*0017 I deltaTloc, uTrans, maskIn,
d7ce0d34f8 Jean*0018 U sm_v, sm_o, sm_x, sm_y, sm_z,
0019 U sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
0020 O uT,
0021 I myThid )
0022
0023
0024
0025
0026
0027
0028
0029
0030
0031
0032
0033
0034
0035
0036
0037
0038
0039
0040 IMPLICIT NONE
0041 #include "SIZE.h"
00fdbdcbd5 Jean*0042 #include "EEPARAMS.h"
d7ce0d34f8 Jean*0043 #include "GAD.h"
1574069d50 Mart*0044 #ifdef ALLOW_AUTODIFF_TAMC
0045 # include "tamc.h"
0046 #endif
d7ce0d34f8 Jean*0047
0048
b79a2b44f2 Jean*0049
0050
0051
0052
0053
0054
0055
72de869c1b Jean*0056
b79a2b44f2 Jean*0057
d7ce0d34f8 Jean*0058 INTEGER bi,bj,k
0059 INTEGER limiter
b79a2b44f2 Jean*0060 LOGICAL overlapOnly, interiorOnly
0061 LOGICAL N_edge, S_edge, E_edge, W_edge
d7ce0d34f8 Jean*0062 _RL deltaTloc
0063 _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
72de869c1b Jean*0064 _RS maskIn(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
d7ce0d34f8 Jean*0065 INTEGER myThid
0066
0067
0068
0069
0070
0071
0072
0073
0074 _RL sm_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0075 _RL sm_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0076 _RL sm_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0077 _RL sm_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0078 _RL sm_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0079 _RL sm_xx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0080 _RL sm_yy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0081 _RL sm_zz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0082 _RL sm_xy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0083 _RL sm_xz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0084 _RL sm_yz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0085 _RL uT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0086
7448700841 Mart*0087 #if ( defined GAD_ALLOW_TS_SOM_ADV || defined PTRACERS_ALLOW_DYN_STATE )
d7ce0d34f8 Jean*0088
b79a2b44f2 Jean*0089
0090
0091
0092
0093
00fdbdcbd5 Jean*0094 _RL three
d7ce0d34f8 Jean*0095 PARAMETER( three = 3. _d 0 )
0096 INTEGER i,j
b79a2b44f2 Jean*0097 INTEGER ns, nbStrips
0098 INTEGER iMinUpd(2), iMaxUpd(2), jMinUpd(2), jMaxUpd(2)
9822905e7f Jean*0099 _RL recip_dT
d7ce0d34f8 Jean*0100 _RL slpmax, s1max, s1new, s2new
0101 _RL uLoc, alf1, alf1q, alpmn
0102 _RL alfp, alpq, alp1, locTp
0103 _RL alfn, alnq, aln1, locTn
0104 _RL alp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0105 _RL aln (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0106 _RL fp_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0107 _RL fn_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0108 _RL fp_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0109 _RL fn_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0110 _RL fp_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0111 _RL fn_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0112 _RL fp_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0113 _RL fn_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0114 _RL fp_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0115 _RL fn_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0116 _RL fp_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0117 _RL fn_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0118 _RL fp_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0119 _RL fn_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0120 _RL fp_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0121 _RL fn_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0122 _RL fp_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0123 _RL fn_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0124 _RL fp_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0125 _RL fn_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0126 _RL fp_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0127 _RL fn_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0128
0129
1574069d50 Mart*0130 #ifdef ALLOW_AUTODIFF_TAMC
0131
0132 #endif
9822905e7f Jean*0133 recip_dT = 0.
00fdbdcbd5 Jean*0134 IF ( deltaTloc.GT.zeroRL ) recip_dT = 1.0 _d 0 / deltaTloc
9822905e7f Jean*0135
b79a2b44f2 Jean*0136
0137 nbStrips = 1
72de869c1b Jean*0138 iMinUpd(1) = 1-OLx+1
0139 iMaxUpd(1) = sNx+OLx-1
0140 jMinUpd(1) = 1-OLy
0141 jMaxUpd(1) = sNy+OLy
b79a2b44f2 Jean*0142 IF ( overlapOnly ) THEN
0143
0144 IF ( W_edge ) iMinUpd(1) = 1
0145 IF ( E_edge ) iMaxUpd(1) = sNx
0146 IF ( S_edge ) THEN
72de869c1b Jean*0147 jMinUpd(1) = 1-OLy
b79a2b44f2 Jean*0148 jMaxUpd(1) = 0
0149 ENDIF
0150 IF ( N_edge ) THEN
0151 IF ( S_edge ) nbStrips = 2
0152 jMinUpd(nbStrips) = sNy+1
72de869c1b Jean*0153 jMaxUpd(nbStrips) = sNy+OLy
b79a2b44f2 Jean*0154 ENDIF
0155 ELSE
0156
0157 IF ( interiorOnly .AND. S_edge ) jMinUpd(1) = 1
0158 IF ( interiorOnly .AND. N_edge ) jMaxUpd(1) = sNy
0159 ENDIF
0160
0161
0162 DO ns=1,nbStrips
0163
d7ce0d34f8 Jean*0164 IF ( limiter.EQ.1 ) THEN
1574069d50 Mart*0165 #ifdef ALLOW_AUTODIFF_TAMC
7448700841 Mart*0166
1574069d50 Mart*0167
0168 #endif
b79a2b44f2 Jean*0169 DO j=jMinUpd(ns),jMaxUpd(ns)
0170 DO i=iMinUpd(1)-1,iMaxUpd(1)+1
d7ce0d34f8 Jean*0171
0172
0173 slpmax = 0.
00fdbdcbd5 Jean*0174 IF ( sm_o(i,j).GT.zeroRL ) slpmax = sm_o(i,j)
d7ce0d34f8 Jean*0175 s1max = slpmax*1.5 _d 0
0176 s1new = MIN( s1max, MAX(-s1max,sm_x(i,j)) )
0177 s2new = MIN( (slpmax+slpmax-ABS(s1new)/three),
0178 & MAX(ABS(s1new)-slpmax,sm_xx(i,j)) )
0179 sm_xy(i,j) = MIN( slpmax, MAX(-slpmax,sm_xy(i,j)) )
0180 sm_xz(i,j) = MIN( slpmax, MAX(-slpmax,sm_xz(i,j)) )
a5a86b736b Jean*0181 sm_x (i,j) = s1new
0182 sm_xx(i,j) = s2new
d7ce0d34f8 Jean*0183 ENDDO
0184 ENDDO
0185 ENDIF
0186
1574069d50 Mart*0187 #ifdef ALLOW_AUTODIFF_TAMC
0188
0189
0190 #endif
d7ce0d34f8 Jean*0191
0192
b79a2b44f2 Jean*0193 DO j=jMinUpd(ns),jMaxUpd(ns)
0194 DO i=iMinUpd(1),iMaxUpd(1)+1
d7ce0d34f8 Jean*0195 uLoc = uTrans(i,j)*deltaTloc
0196
00fdbdcbd5 Jean*0197 fp_v (i,j) = MAX( zeroRL, uLoc )
d7ce0d34f8 Jean*0198 alp (i,j) = fp_v(i,j)/sm_v(i-1,j)
0199 alpq = alp(i,j)*alp(i,j)
0200 alp1 = 1. _d 0 - alp(i,j)
0201
0202
0203 fp_o (i,j) = alp(i,j)*( sm_o(i-1,j) + alp1*sm_x(i-1,j)
0204 & + alp1*(alp1-alp(i,j))*sm_xx(i-1,j)
0205 & )
0206 fp_x (i,j) = alpq *( sm_x(i-1,j) + three*alp1*sm_xx(i-1,j) )
0207 fp_xx(i,j) = alp(i,j)*alpq*sm_xx(i-1,j)
0208 fp_y (i,j) = alp(i,j)*( sm_y(i-1,j) + alp1*sm_xy(i-1,j) )
0209 fp_z (i,j) = alp(i,j)*( sm_z(i-1,j) + alp1*sm_xz(i-1,j) )
0210 fp_xy(i,j) = alpq *sm_xy(i-1,j)
0211 fp_xz(i,j) = alpq *sm_xz(i-1,j)
0212 fp_yy(i,j) = alp(i,j)*sm_yy(i-1,j)
0213 fp_zz(i,j) = alp(i,j)*sm_zz(i-1,j)
0214 fp_yz(i,j) = alp(i,j)*sm_yz(i-1,j)
0215
00fdbdcbd5 Jean*0216 fn_v (i,j) = MAX( zeroRL, -uLoc )
d7ce0d34f8 Jean*0217 aln (i,j) = fn_v(i,j)/sm_v( i ,j)
0218 alnq = aln(i,j)*aln(i,j)
0219 aln1 = 1. _d 0 - aln(i,j)
0220
0221
0222 fn_o (i,j) = aln(i,j)*( sm_o( i ,j) - aln1*sm_x( i ,j)
0223 & + aln1*(aln1-aln(i,j))*sm_xx( i ,j)
0224 & )
0225 fn_x (i,j) = alnq *( sm_x( i ,j) - three*aln1*sm_xx( i ,j) )
0226 fn_xx(i,j) = aln(i,j)*alnq*sm_xx( i ,j)
0227 fn_y (i,j) = aln(i,j)*( sm_y( i ,j) - aln1*sm_xy( i ,j) )
0228 fn_z (i,j) = aln(i,j)*( sm_z( i ,j) - aln1*sm_xz( i ,j) )
0229 fn_xy(i,j) = alnq *sm_xy( i ,j)
0230 fn_xz(i,j) = alnq *sm_xz( i ,j)
0231 fn_yy(i,j) = aln(i,j)*sm_yy( i ,j)
0232 fn_zz(i,j) = aln(i,j)*sm_zz( i ,j)
0233 fn_yz(i,j) = aln(i,j)*sm_yz( i ,j)
0234
9822905e7f Jean*0235 uT(i,j) = ( fp_o(i,j) - fn_o(i,j) )*recip_dT
d7ce0d34f8 Jean*0236 ENDDO
0237 ENDDO
0238
b79a2b44f2 Jean*0239
0240
0241
1574069d50 Mart*0242 #ifdef ALLOW_AUTODIFF_TAMC
7448700841 Mart*0243
1574069d50 Mart*0244
0245 #endif
d7ce0d34f8 Jean*0246
b79a2b44f2 Jean*0247
0248
0249
d7ce0d34f8 Jean*0250
0251
b79a2b44f2 Jean*0252 DO j=jMinUpd(ns),jMaxUpd(ns)
0253 DO i=iMinUpd(1),iMaxUpd(1)
72de869c1b Jean*0254 #ifdef ALLOW_OBCS
00fdbdcbd5 Jean*0255 IF ( maskIn(i,j).NE.zeroRS ) THEN
72de869c1b Jean*0256 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0257 alf1 = 1. _d 0 - aln(i,j) - alp(i+1,j)
0258 alf1q = alf1*alf1
0259 alpmn = alp(i+1,j) - aln(i,j)
0260 sm_v (i,j) = sm_v (i,j) - fn_v (i,j) - fp_v (i+1,j)
0261 sm_o (i,j) = sm_o (i,j) - fn_o (i,j) - fp_o (i+1,j)
0262 sm_x (i,j) = alf1q*( sm_x(i,j) - three*alpmn*sm_xx(i,j) )
0263 sm_xx(i,j) = alf1*alf1q*sm_xx(i,j)
0264 sm_xy(i,j) = alf1q*sm_xy(i,j)
0265 sm_xz(i,j) = alf1q*sm_xz(i,j)
0266 sm_y (i,j) = sm_y (i,j) - fn_y (i,j) - fp_y (i+1,j)
0267 sm_yy(i,j) = sm_yy(i,j) - fn_yy(i,j) - fp_yy(i+1,j)
0268 sm_z (i,j) = sm_z (i,j) - fn_z (i,j) - fp_z (i+1,j)
0269 sm_zz(i,j) = sm_zz(i,j) - fn_zz(i,j) - fp_zz(i+1,j)
0270 sm_yz(i,j) = sm_yz(i,j) - fn_yz(i,j) - fp_yz(i+1,j)
72de869c1b Jean*0271 #ifdef ALLOW_OBCS
0272 ENDIF
0273 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0274 ENDDO
0275 ENDDO
0276
0277
0278
0279
b79a2b44f2 Jean*0280 DO j=jMinUpd(ns),jMaxUpd(ns)
0281 DO i=iMinUpd(1),iMaxUpd(1)
72de869c1b Jean*0282 #ifdef ALLOW_OBCS
00fdbdcbd5 Jean*0283 IF ( maskIn(i,j).NE.zeroRS ) THEN
72de869c1b Jean*0284 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0285 sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i+1,j)
0286 alfp = fp_v( i ,j)/sm_v(i,j)
0287 alfn = fn_v(i+1,j)/sm_v(i,j)
0288 alf1 = 1. _d 0 - alfp - alfn
0289 alp1 = 1. _d 0 - alfp
0290 aln1 = 1. _d 0 - alfn
0291 alpmn = alfp - alfn
0292 locTp = alfp*sm_o(i,j) - alp1*fp_o(i,j)
0293 locTn = alfn*sm_o(i,j) - aln1*fn_o(i+1,j)
0294 sm_xx(i,j) = alf1*alf1*sm_xx(i,j) + alfp*alfp*fp_xx(i,j)
0295 & + alfn*alfn*fn_xx(i+1,j)
0296 & - 5. _d 0*(-alpmn*alf1*sm_x(i,j) + alfp*alp1*fp_x(i,j)
0297 & - alfn*aln1*fn_x(i+1,j)
00fdbdcbd5 Jean*0298 & + twoRL*alfp*alfn*sm_o(i,j) + (alp1-alfp)*locTp
0299 & + (aln1-alfn)*locTn
d7ce0d34f8 Jean*0300 & )
0301 sm_xy(i,j) = alf1*sm_xy(i,j) + alfp*fp_xy(i,j)
0302 & + alfn*fn_xy(i+1,j)
0303 & + three*( alpmn*sm_y(i,j) - alp1*fp_y(i,j)
0304 & + aln1*fn_y(i+1,j)
0305 & )
0306 sm_xz(i,j) = alf1*sm_xz(i,j) + alfp*fp_xz(i,j)
0307 & + alfn*fn_xz(i+1,j)
0308 & + three*( alpmn*sm_z(i,j) - alp1*fp_z(i,j)
0309 & + aln1*fn_z(i+1,j)
0310 & )
0311 sm_x (i,j) = alf1*sm_x(i,j) + alfp*fp_x(i,j) + alfn*fn_x(i+1,j)
0312 & + three*( locTp - locTn )
0313 sm_o (i,j) = sm_o (i,j) + fp_o (i,j) + fn_o (i+1,j)
0314 sm_y (i,j) = sm_y (i,j) + fp_y (i,j) + fn_y (i+1,j)
0315 sm_yy(i,j) = sm_yy(i,j) + fp_yy(i,j) + fn_yy(i+1,j)
0316 sm_z (i,j) = sm_z (i,j) + fp_z (i,j) + fn_z (i+1,j)
0317 sm_zz(i,j) = sm_zz(i,j) + fp_zz(i,j) + fn_zz(i+1,j)
0318 sm_yz(i,j) = sm_yz(i,j) + fp_yz(i,j) + fn_yz(i+1,j)
72de869c1b Jean*0319 #ifdef ALLOW_OBCS
0320 ENDIF
0321 #endif /* ALLOW_OBCS */
d7ce0d34f8 Jean*0322 ENDDO
0323 ENDDO
0324
b79a2b44f2 Jean*0325
0326 ENDDO
7448700841 Mart*0327 #endif /* GAD_ALLOW_TS_SOM_ADV or PTRACERS_ALLOW_DYN_STATE */
b79a2b44f2 Jean*0328
d7ce0d34f8 Jean*0329 RETURN
0330 END