pkg/gmredi/gmredi_residual_flow.F

955d21dfcb Jean*0001 #include "GMREDI_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: GMREDI_RESIDUAL_FLOW
                0005 C     !INTERFACE:
                0006       SUBROUTINE GMREDI_RESIDUAL_FLOW(
                0007      U                  uFld, vFld, wFld,
                0008      I                  bi, bj, myIter, myThid )
                0009 C     !DESCRIPTION:
                0010 C     Add GM-bolus velocity to Eulerian velocity to get Residual Mean velocity.
                0011
                0012 C     !USES:
                0013       IMPLICIT NONE
                0014
                0015 C     == GLobal variables ==
                0016 #include "SIZE.h"
                0017 #include "EEPARAMS.h"
                0018 #include "PARAMS.h"
                0019 #include "GRID.h"
                0020 #include "GMREDI.h"
                0021 #ifdef ALLOW_EDDYPSI
                0022 # include "DYNVARS.h"
5a207a41d5 Jean*0023 # include "FFIELDS.h"
955d21dfcb Jean*0024 #endif
                0025
                0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     == Routine arguments ==
                0028 C     uFld   :: zonal      velocity (updated)
                0029 C     vFld   :: meridional velocity (updated)
                0030 C     wFld   :: vertical volume transport (updated)
                0031 C     bi,bj  :: tile indices
                0032 C     myIter :: my Iteration number
                0033 C     myThid :: my Thread Id number
                0034       INTEGER bi, bj, myIter, myThid
                0035       _RL uFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0036       _RL vFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0037       _RL wFld  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0038
                0039 #ifdef ALLOW_GMREDI
                0040 #ifdef GM_BOLUS_ADVEC
                0041
                0042 C     !LOCAL VARIABLES:
                0043 C     == Local variables ==
                0044 C     i, j, k :: loop indices
                0045       INTEGER i, j, k
                0046       INTEGER kp1
5b172de0d2 Jean*0047       _RL maskp1, flipSign4LHCoord
955d21dfcb Jean*0048       _RL delPsi
                0049 #ifdef ALLOW_EDDYPSI
                0050       _RL ustar, vstar
                0051 #endif
                0052 CEOP
                0053
5b172de0d2 Jean*0054 C     Since bolus transport is computed as curl of stream-function, needs to
                0055 C     flip sign when using Left-Handed Coordinate system such as P-coordinate
                0056       flipSign4LHCoord = -gravitySign
                0057
955d21dfcb Jean*0058       IF ( GM_AdvForm .AND. .NOT.GM_AdvSeparate
                0059      &     .AND. .NOT.GM_InMomAsStress ) THEN
                0060
                0061        DO k=1,Nr
                0062         kp1 = MIN(k+1,Nr)
                0063         maskp1 = 1.
                0064         IF (k.GE.Nr) maskp1 = 0.
                0065
                0066         DO j=1-OLy,sNy+OLy
                0067          DO i=1-OLx,sNx+OLx
a67797e4f0 Jean*0068            delPsi = GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0069      &            - GM_PsiX(i,j, k, bi,bj)*deepFacF(k)
955d21dfcb Jean*0070            uFld(i,j,k) = uFld(i,j,k)
                0071      &                 + delPsi*recip_drF(k)*_recip_hFacW(i,j,k,bi,bj)
5b172de0d2 Jean*0072      &                         *recip_deepFacC(k)*flipSign4LHCoord
955d21dfcb Jean*0073          ENDDO
                0074         ENDDO
                0075         DO j=1-OLy,sNy+OLy
                0076          DO i=1-OLx,sNx+OLx
a67797e4f0 Jean*0077            delPsi = GM_PsiY(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0078      &            - GM_PsiY(i,j, k, bi,bj)*deepFacF(k)
955d21dfcb Jean*0079            vFld(i,j,k) = vFld(i,j,k)
                0080      &                 + delPsi*recip_drF(k)*_recip_hFacS(i,j,k,bi,bj)
5b172de0d2 Jean*0081      &                         *recip_deepFacC(k)*flipSign4LHCoord
955d21dfcb Jean*0082          ENDDO
                0083         ENDDO
a67797e4f0 Jean*0084 C       deep-model: simplify FacF / Fac2F (from dx,y / rA) to: 1/FacF
955d21dfcb Jean*0085         DO j=1-OLy,sNy+OLy-1
                0086          DO i=1-OLx,sNx+OLx-1
                0087            delPsi = ( dyG(i+1,j,bi,bj)*GM_PsiX(i+1,j,k,bi,bj)
                0088      &               -dyG( i ,j,bi,bj)*GM_PsiX( i ,j,k,bi,bj)
                0089      &               +dxG(i,j+1,bi,bj)*GM_PsiY(i,j+1,k,bi,bj)
                0090      &               -dxG(i, j ,bi,bj)*GM_PsiY(i, j ,k,bi,bj)
5b172de0d2 Jean*0091      &              )
                0092            wFld(i,j,k) = wFld(i,j,k)
                0093      &                 + delPsi*recip_rA(i,j,bi,bj)
                0094      &                         *recip_deepFacF(k)*flipSign4LHCoord
955d21dfcb Jean*0095          ENDDO
                0096         ENDDO
                0097
                0098        ENDDO
                0099
                0100 #ifdef ALLOW_EDDYPSI
                0101       ELSEIF( GM_AdvForm .AND. .NOT.GM_AdvSeparate
                0102      &        .AND. GM_InMomAsStress ) THEN
                0103
                0104 C     Calculate the mean velocity from the residual and bolus
                0105        DO k=1,Nr
                0106         kp1 = MIN(k+1,Nr)
                0107         maskp1 = 1.
                0108         IF (k.GE.Nr) maskp1 = 0.
                0109
                0110         DO j=1-OLy,sNy+OLy
                0111          DO i=1-OLx,sNx+OLx
a67797e4f0 Jean*0112           delPsi = GM_PsiX(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0113      &           - GM_PsiX(i,j, k, bi,bj)*deepFacF(k)
955d21dfcb Jean*0114           ustar = delPsi*recip_drF(k)*_recip_hFacW(i,j,k,bi,bj)
5b172de0d2 Jean*0115      &                  *recip_deepFacC(k)*flipSign4LHCoord
5a207a41d5 Jean*0116           uEulerMean(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) - ustar
955d21dfcb Jean*0117          ENDDO
                0118         ENDDO
                0119         DO j=1-OLy,sNy+OLy
                0120          DO i=1-OLx,sNx+OLx
a67797e4f0 Jean*0121           delPsi = GM_PsiY(i,j,kp1,bi,bj)*deepFacF(kp1)*maskp1
                0122      &           - GM_PsiY(i,j, k, bi,bj)*deepFacF(k)
955d21dfcb Jean*0123           vstar  = delPsi*recip_drF(k)*_recip_hFacS(i,j,k,bi,bj)
5b172de0d2 Jean*0124      &                   *recip_deepFacC(k)*flipSign4LHCoord
5a207a41d5 Jean*0125           vEulerMean(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) - vstar
955d21dfcb Jean*0126          ENDDO
                0127         ENDDO
                0128
                0129        ENDDO
                0130
                0131 #ifdef ALLOW_DIAGNOSTICS
5a207a41d5 Jean*0132        IF ( useDiagnostics ) THEN
                0133         CALL DIAGNOSTICS_FILL(uEulerMean,'U_EulerM',0,Nr,1,bi,bj,myThid)
                0134         CALL DIAGNOSTICS_FILL(vEulerMean,'V_EulerM',0,Nr,1,bi,bj,myThid)
                0135        ENDIF
955d21dfcb Jean*0136 #endif /* ALLOW_DIAGNOSTICS */
                0137 #endif /* ALLOW_EDDYPSI */
                0138
                0139       ENDIF
                0140 #endif /* GM_BOLUS_ADVEC */
                0141 #endif /* ALLOW_GMREDI */
                0142
                0143       RETURN
                0144       END