File indexing completed on 2023-02-03 06:10:07 UTC
view on githubraw file Latest commit edb66560 on 2023-02-02 23:32:31 UTC
0c49347dc7 Alis*0001 #include "GMREDI_OPTIONS.h"
14e0496834 Jean*0002 #ifdef ALLOW_AUTODIFF
0003 # include "AUTODIFF_OPTIONS.h"
0004 #endif
0c49347dc7 Alis*0005
14e0496834 Jean*0006
0007
0008
2ae58a73ff Jean*0009 SUBROUTINE GMREDI_XTRANSPORT(
e9de1d7682 Jean*0010 I trIdentity, bi, bj, k,
0011 I iMin, iMax, jMin, jMax,
8233d0ceb9 Jean*0012 I xA, maskFk, Tracer,
0c49347dc7 Alis*0013 U df,
e9de1d7682 Jean*0014 I myThid )
14e0496834 Jean*0015
0016
2ae58a73ff Jean*0017
0018
0019
0020
0021
14e0496834 Jean*0022
0c49347dc7 Alis*0023
14e0496834 Jean*0024
0025 IMPLICIT NONE
0c49347dc7 Alis*0026
0027 #include "SIZE.h"
0028 #include "EEPARAMS.h"
0029 #include "PARAMS.h"
0030 #include "GRID.h"
0031 #include "GMREDI.h"
0032
b6b11b9b2f Patr*0033 #ifdef ALLOW_AUTODIFF_TAMC
27cc6013c1 Patr*0034 # include "tamc.h"
0035 # ifdef ALLOW_PTRACERS
0036 # include "PTRACERS_SIZE.h"
0037 # endif
b6b11b9b2f Patr*0038 #endif /* ALLOW_AUTODIFF_TAMC */
0039
14e0496834 Jean*0040
8233d0ceb9 Jean*0041
0042
0043
0044
0045
0046
0047
0048
0049
0050
e9de1d7682 Jean*0051 INTEGER trIdentity
0052 INTEGER bi, bj, k
0053 INTEGER iMin, iMax, jMin, jMax
8233d0ceb9 Jean*0054 _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0055 _RS maskFk(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
e9de1d7682 Jean*0056 _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
0c49347dc7 Alis*0057 _RL df (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0058 INTEGER myThid
14e0496834 Jean*0059
0c49347dc7 Alis*0060
0061 #ifdef ALLOW_GMREDI
14e0496834 Jean*0062
8233d0ceb9 Jean*0063
e9de1d7682 Jean*0064 INTEGER i, j
2ae58a73ff Jean*0065 #if ( defined (GM_EXTRA_DIAGONAL) || defined (GM_BOLUS_ADVEC) )
0066 INTEGER kp1
8233d0ceb9 Jean*0067 _RL maskp1
2ae58a73ff Jean*0068 #endif
9cb619cfcd Patr*0069 #ifdef GM_EXTRA_DIAGONAL
2ae58a73ff Jean*0070 INTEGER km1
9cb619cfcd Patr*0071 _RL dTdz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0072 #endif
0073 #ifdef GM_BOLUS_ADVEC
0074 _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
5a08ec604d Davi*0075 #ifdef ALLOW_DIAGNOSTICS
0076 LOGICAL DIAGNOSTICS_IS_ON
0077 EXTERNAL DIAGNOSTICS_IS_ON
0078 _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0079 #endif
2ae58a73ff Jean*0080 #endif /* GM_BOLUS_ADVEC */
7c50f07931 Mart*0081 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0082
0083 INTEGER kkey
0084 CHARACTER*(MAX_LEN_MBUF) msgBuf
7c50f07931 Mart*0085 #endif
0c49347dc7 Alis*0086
b6b11b9b2f Patr*0087 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0088 kkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
0089 kkey = trIdentity + (kkey-1)*maxpass
0090 kkey = k + (kkey-1)*Nr
7c50f07931 Mart*0091 IF (trIdentity.GT.maxpass) THEN
edb6656069 Mart*0092 WRITE(msgBuf,'(A,2I5)')
0093 & 'GMREDI_XTRANSPORT: trIdentity > maxpass ',
0094 & trIdentity, maxpass
0095 CALL PRINT_ERROR( msgBuf, myThid )
0096 STOP 'ABNORMAL END: S/R GMREDI_XTRANSPORT'
7c50f07931 Mart*0097 ENDIF
b6b11b9b2f Patr*0098 #endif /* ALLOW_AUTODIFF_TAMC */
0099
2a09713997 Patr*0100 IF (useGMRedi) THEN
2ae58a73ff Jean*0101
b6b11b9b2f Patr*0102 #ifdef ALLOW_AUTODIFF_TAMC
2ae58a73ff Jean*0103
10d4db6918 Patr*0104
0105 # ifdef GM_EXTRA_DIAGONAL
0106
0107
0108 # endif
14e0496834 Jean*0109 #endif /* ALLOW_AUTODIFF_TAMC */
0c49347dc7 Alis*0110
0111
0112 DO j=jMin,jMax
0113 DO i=iMin,iMax
0114 df(i,j) = df(i,j)
f42e64b3e7 Jean*0115 & -xA(i,j)
0116 & *Kux(i,j,k,bi,bj)
a67797e4f0 Jean*0117 & *_recip_dxC(i,j,bi,bj)*recip_deepFacC(k)
0118 & *( Tracer(i,j,k) - Tracer(i-1,j,k) )
0c49347dc7 Alis*0119 ENDDO
0120 ENDDO
0121
f42e64b3e7 Jean*0122 #ifdef GM_EXTRA_DIAGONAL
796b5e35f7 Jean*0123 IF ( GM_ExtraDiag ) THEN
f42e64b3e7 Jean*0124 km1 = MAX(k-1,1)
0125 kp1 = MIN(k+1,Nr)
e9de1d7682 Jean*0126
8233d0ceb9 Jean*0127
0128
0129
0130 maskp1 = 1. _d 0
0131 IF (k.GE.Nr) maskp1 = 0. _d 0
f42e64b3e7 Jean*0132 DO j=jMin,jMax
0133 DO i=iMin,iMax
8233d0ceb9 Jean*0134 dTdz(i,j) = op5*(
796b5e35f7 Jean*0135 & +op5*recip_drC(k)*
8233d0ceb9 Jean*0136 & ( maskFk(i-1,j)*
0137 & ( Tracer(i-1,j,km1)-Tracer(i-1,j,k) )
0138 & +maskFk( i ,j)*
0139 & ( Tracer( i ,j,km1)-Tracer( i ,j,k) )
796b5e35f7 Jean*0140 & )
0141 & +op5*recip_drC(kp1)*
8233d0ceb9 Jean*0142 & ( maskC(i-1,j,k,bi,bj)*maskC(i-1,j,kp1,bi,bj)*maskp1*
0143 & ( Tracer(i-1,j,k)-Tracer(i-1,j,kp1) )
0144 & +maskC( i ,j,k,bi,bj)*maskC( i ,j,kp1,bi,bj)*maskp1*
0145 & ( Tracer( i ,j,k)-Tracer( i ,j,kp1) )
0146 & ) )
f42e64b3e7 Jean*0147 ENDDO
0148 ENDDO
9cb619cfcd Patr*0149 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
796b5e35f7 Jean*0150
9cb619cfcd Patr*0151
0152 #endif
e9de1d7682 Jean*0153
9cb619cfcd Patr*0154 DO j=jMin,jMax
0155 DO i=iMin,iMax
796b5e35f7 Jean*0156 df(i,j) = df(i,j) - xA(i,j)*Kuz(i,j,k,bi,bj)*dTdz(i,j)
9cb619cfcd Patr*0157 ENDDO
0158 ENDDO
f42e64b3e7 Jean*0159 ENDIF
0160 #endif /* GM_EXTRA_DIAGONAL */
0161
0162 #ifdef GM_BOLUS_ADVEC
796b5e35f7 Jean*0163 IF ( GM_AdvForm .AND. GM_AdvSeparate
0164 & .AND. .NOT.GM_InMomAsStress ) THEN
5b172de0d2 Jean*0165
0166
0167
f42e64b3e7 Jean*0168 kp1 = MIN(k+1,Nr)
8233d0ceb9 Jean*0169 maskp1 = 1. _d 0
0170 IF (k.GE.Nr) maskp1 = 0. _d 0
f42e64b3e7 Jean*0171 DO j=jMin,jMax
0172 DO i=iMin,iMax
5b172de0d2 Jean*0173 uTrans(i,j) = -gravitySign*dyG(i,j,bi,bj)
a67797e4f0 Jean*0174 & *( GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
0175 & - GM_PsiX(i,j, k ,bi,bj)*deepFacF(k)
0176 & )*maskW(i,j,k,bi,bj)
9cb619cfcd Patr*0177 ENDDO
0178 ENDDO
0179 #ifdef GM_AUTODIFF_EXCESSIVE_STORE
796b5e35f7 Jean*0180
9cb619cfcd Patr*0181
0182 #endif
0183 DO j=jMin,jMax
0184 DO i=iMin,iMax
f42e64b3e7 Jean*0185 df(i,j) = df(i,j)
a67797e4f0 Jean*0186 & + uTrans(i,j)*op5*( Tracer(i,j,k) + Tracer(i-1,j,k) )
f42e64b3e7 Jean*0187 ENDDO
0188 ENDDO
0189 ENDIF
5a08ec604d Davi*0190
0191
2ae58a73ff Jean*0192
0193 #ifdef ALLOW_DIAGNOSTICS
a67797e4f0 Jean*0194 IF ( useDiagnostics .AND. trIdentity.EQ.1 .AND.
0195 & DIAGNOSTICS_IS_ON( 'GM_ubT ', myThid ) ) THEN
5a08ec604d Davi*0196 kp1 = MIN(k+1,Nr)
8233d0ceb9 Jean*0197 maskp1 = 1. _d 0
0198 IF (k.GE.Nr) maskp1 = 0. _d 0
5a08ec604d Davi*0199 DO j=jMin,jMax
0200 DO i=iMin,iMax
5b172de0d2 Jean*0201 tmp1k(i,j) = -gravitySign*dyG(i,j,bi,bj)
a67797e4f0 Jean*0202 & *( GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
0203 & - GM_PsiX(i,j, k ,bi,bj)*deepFacF(k)
0204 & )*maskW(i,j,k,bi,bj)
0205 & *op5*( Tracer(i,j,k) + Tracer(i-1,j,k) )
5a08ec604d Davi*0206 ENDDO
0207 ENDDO
0208 CALL DIAGNOSTICS_FILL(tmp1k,'GM_ubT ', k,1,2,bi,bj,myThid)
0209 ENDIF
0210 #endif /* ALLOW_DIAGNOSTICS */
0211
f42e64b3e7 Jean*0212 #endif /* GM_BOLUS_ADVEC */
0213
0c49347dc7 Alis*0214 ENDIF
0215 #endif /* ALLOW_GMREDI */
0216
0217 RETURN
0218 END