pkg/generic_advdiff/gad_dst3_adv_y.F

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