pkg/generic_advdiff/gad_dst3_adv_x.F

6d046cd062 Alis*0001 #include "GAD_OPTIONS.h"
                0002
cf79b8bd99 Jean*0003 CBOP
                0004 C !ROUTINE: GAD_DST3_ADV_X
                0005
                0006 C !INTERFACE: ==========================================================
0af3073e4e Jean*0007       SUBROUTINE GAD_DST3_ADV_X(
692dd30681 Jean*0008      I           bi,bj,k, calcCFL, deltaTloc,
0af3073e4e Jean*0009      I           uTrans, uFld,
38a970fb5d Jean*0010      I           maskLocW, tracer,
6d046cd062 Alis*0011      O           uT,
                0012      I           myThid )
cf79b8bd99 Jean*0013
                0014 C !DESCRIPTION:
                0015 C  Calculates the area integrated zonal flux due to advection of a
                0016 C  tracer using 3rd-order Direct Space and Time (DST-3) Advection Scheme
                0017
                0018 C !USES: ===============================================================
6d046cd062 Alis*0019       IMPLICIT NONE
                0020
                0021 C     == GLobal variables ==
                0022 #include "SIZE.h"
cc94647d10 Jean*0023 #ifdef OLD_DST3_FORMULATION
b79a37688e Patr*0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
cc94647d10 Jean*0026 #endif
                0027 #include "GRID.h"
6d046cd062 Alis*0028 #include "GAD.h"
                0029
                0030 C     == Routine arguments ==
cf79b8bd99 Jean*0031 C !INPUT PARAMETERS: ===================================================
                0032 C  bi,bj             :: tile indices
                0033 C  k                 :: vertical level
692dd30681 Jean*0034 C  calcCFL           :: =T: calculate CFL number ; =F: take uFld as CFL.
cf79b8bd99 Jean*0035 C  deltaTloc         :: local time-step (s)
                0036 C  uTrans            :: zonal volume transport
692dd30681 Jean*0037 C  uFld              :: zonal flow / CFL number
cf79b8bd99 Jean*0038 C  tracer            :: tracer field
                0039 C  myThid            :: thread number
6d046cd062 Alis*0040       INTEGER bi,bj,k
692dd30681 Jean*0041       LOGICAL calcCFL
b79a37688e Patr*0042       _RL deltaTloc
6d046cd062 Alis*0043       _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0af3073e4e Jean*0044       _RL uFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
38a970fb5d Jean*0045       _RS maskLocW(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
6d046cd062 Alis*0046       _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0047       INTEGER myThid
                0048
cf79b8bd99 Jean*0049 C !OUTPUT PARAMETERS: ==================================================
                0050 C  uT                :: zonal advective flux
                0051       _RL uT    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0052
6d046cd062 Alis*0053 C     == Local variables ==
cf79b8bd99 Jean*0054 C !LOCAL VARIABLES: ====================================================
                0055 C  i,j               :: loop indices
62743db5c5 Jean*0056 C  uCFL              :: Courant-Friedrich-Levy number
6d046cd062 Alis*0057       INTEGER i,j
62743db5c5 Jean*0058       _RL Rjm,Rj,Rjp,uCFL,d0,d1
cf79b8bd99 Jean*0059 #ifdef OLD_DST3_FORMULATION
6c82a26cad Alis*0060       _RL psiP,psiM,thetaP,thetaM
b79a37688e Patr*0061       _RL smallNo
983c7d32b1 Jean*0062 c     _RL Rjjm,Rjjp
b79a37688e Patr*0063
0d75a51072 Mart*0064 c     IF (inAdMode .AND. useApproxAdvectionInAdMode) THEN
370e5a47fd Jean*0065 c      smallNo = 1.0D-20
                0066 c     ELSE
b79a37688e Patr*0067        smallNo = 1.0D-20
370e5a47fd Jean*0068 c     ENDIF
cf79b8bd99 Jean*0069 #endif
6d046cd062 Alis*0070
370e5a47fd Jean*0071       DO j=1-OLy,sNy+OLy
                0072        uT(1-OLx,j)=0.
                0073        uT(2-OLx,j)=0.
                0074        uT(sNx+OLx,j)=0.
360ad14abb Mart*0075       ENDDO
370e5a47fd Jean*0076       DO j=1-OLy,sNy+OLy
                0077        DO i=1-OLx+2,sNx+OLx-1
38a970fb5d Jean*0078         Rjp=(tracer(i+1,j)-tracer( i ,j))*maskLocW(i+1,j)
                0079         Rj =(tracer( i ,j)-tracer(i-1,j))*maskLocW( i ,j)
                0080         Rjm=(tracer(i-1,j)-tracer(i-2,j))*maskLocW(i-1,j)
6d046cd062 Alis*0081
692dd30681 Jean*0082         uCFL = uFld(i,j)
                0083         IF ( calcCFL ) uCFL = ABS( uFld(i,j)*deltaTloc
62743db5c5 Jean*0084      &                  *recip_dxC(i,j,bi,bj)*recip_deepFacC(k) )
                0085         d0=(2.-uCFL)*(1.-uCFL)*oneSixth
                0086         d1=(1.-uCFL*uCFL)*oneSixth
cf79b8bd99 Jean*0087 #ifdef OLD_DST3_FORMULATION
b79a37688e Patr*0088         IF ( ABS(Rj).LT.smallNo .OR.
                0089      &       ABS(Rjm).LT.smallNo ) THEN
                0090          thetaP=0.
                0091          psiP=0.
                0092         ELSE
                0093          thetaP=(Rjm+smallNo)/(smallNo+Rj)
                0094          psiP=d0+d1*thetaP
                0095         ENDIF
                0096         IF ( ABS(Rj).LT.smallNo .OR.
                0097      &       ABS(Rjp).LT.smallNo ) THEN
                0098          thetaM=0.
                0099          psiM=0.
                0100         ELSE
                0101          thetaM=(Rjp+smallNo)/(smallNo+Rj)
                0102          psiM=d0+d1*thetaM
                0103         ENDIF
6d046cd062 Alis*0104         uT(i,j)=
cf79b8bd99 Jean*0105      &   0.5*(uTrans(i,j)+ABS(uTrans(i,j)))
6c82a26cad Alis*0106      &      *( Tracer(i-1,j) + psiP*Rj )
cf79b8bd99 Jean*0107      &  +0.5*(uTrans(i,j)-ABS(uTrans(i,j)))
6c82a26cad Alis*0108      &      *( Tracer( i ,j) - psiM*Rj )
cf79b8bd99 Jean*0109 #else /* OLD_DST3_FORMULATION */
                0110         uT(i,j)=
                0111      &   0.5*(uTrans(i,j)+ABS(uTrans(i,j)))
                0112      &      *( Tracer(i-1,j) + (d0*Rj+d1*Rjm) )
                0113      &  +0.5*(uTrans(i,j)-ABS(uTrans(i,j)))
                0114      &      *( Tracer( i ,j) - (d0*Rj+d1*Rjp) )
                0115 #endif /* OLD_DST3_FORMULATION */
6d046cd062 Alis*0116
                0117        ENDDO
                0118       ENDDO
                0119
                0120       RETURN
                0121       END