model/src/timestep_wvel.F

52c561f327 Jean*0001 #include "CPP_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: TIMESTEP_WVEL
                0005 C     !INTERFACE:
                0006       SUBROUTINE TIMESTEP_WVEL(
aab550ebd0 Jean*0007      I                          bi,bj, myTime, myIter, myThid )
52c561f327 Jean*0008 C     !DESCRIPTION: \bv
                0009 C     *==========================================================*
                0010 C     | S/R TIMESTEP_WVEL
                0011 C     | o Step model vertical velocity forward in time
                0012 C     *==========================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 C     == Global variables ==
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "GRID.h"
                0022 #include "DYNVARS.h"
                0023 #include "NH_VARS.h"
                0024 c #include "SURFACE.h"
                0025
                0026 C     !INPUT/OUTPUT PARAMETERS:
                0027 C     == Routine Arguments ==
ba6e8ba5bb Jean*0028 C     bi, bj    :: Tile indices
                0029 C     myTime    :: Current time in simulation
                0030 C     myIter    :: Current iteration number in simulation
                0031 C     myThid    :: my Thread Id. number
aab550ebd0 Jean*0032       INTEGER bi,bj
52c561f327 Jean*0033       _RL     myTime
                0034       INTEGER myIter, myThid
                0035
                0036 #ifdef ALLOW_NONHYDROSTATIC
                0037 C     !LOCAL VARIABLES:
                0038 C     == Local variables ==
ba6e8ba5bb Jean*0039 C     iMin,iMax :: 1rst loop counter range
                0040 C     jMin,jMax :: 2nd  loop counter range
                0041 C     i,j,k     :: Loop counters
                0042 C     gWtmp     :: temporary array for vertical momentum tendency
52c561f327 Jean*0043       INTEGER iMin,iMax,jMin,jMax
982e105a17 Jean*0044       INTEGER i, j, k, km1
52c561f327 Jean*0045       _RL     gWtmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
cb7fa97db9 Jean*0046       _RL     tmpFac, nh_Fac, igwFac
ba6e8ba5bb Jean*0047       PARAMETER( iMin = 1 , iMax = sNx )
                0048       PARAMETER( jMin = 1 , jMax = sNy )
52c561f327 Jean*0049 CEOP
                0050
f056be794c Jean*0051       igwFac = 0. _d 0
                0052       IF ( implicitIntGravWave ) igwFac = 1. _d 0
cb7fa97db9 Jean*0053
52c561f327 Jean*0054 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0055
aab550ebd0 Jean*0056       IF ( nonHydrostatic ) THEN
cb7fa97db9 Jean*0057         nh_Fac = 0.
                0058         IF ( nh_Am2.NE.0. ) nh_Fac = 1. _d 0 / nh_Am2
                0059
982e105a17 Jean*0060         DO k=1,Nr
                0061          km1 = MAX( k-1, 1 )
52c561f327 Jean*0062
16f5093311 Jean*0063          IF ( implicitNHPress.NE.1. _d 0 ) THEN
                0064 C--   add explicit part of NH pressure gradient:
                0065           tmpFac = pfFacMom*(1. _d 0 - implicitNHPress)
982e105a17 Jean*0066      &           * wUnit2rVel(k)*wUnit2rVel(k)*recip_rhoFacF(k)
                0067           IF ( k.GE.2 ) THEN
                0068            DO j=jMin,jMax
                0069             DO i=iMin,iMax
                0070              gW(i,j,k,bi,bj) = gW(i,j,k,bi,bj)
                0071      &              - tmpFac*rkSign*recip_drC(k)
                0072      &              *( phi_nh(i,j,k,bi,bj) - phi_nh(i,j,k-1,bi,bj) )
                0073             ENDDO
16f5093311 Jean*0074            ENDDO
982e105a17 Jean*0075           ELSEIF ( selectNHfreeSurf.GE.1 ) THEN
                0076            DO j=jMin,jMax
                0077             DO i=iMin,iMax
                0078              gW(i,j,k,bi,bj) = gW(i,j,k,bi,bj)
                0079      &              - tmpFac*rkSign*recip_drC(k)
                0080      &              *( phi_nh(i,j,k,bi,bj) - dPhiNH(i,j,bi,bj) )
                0081             ENDDO
                0082            ENDDO
                0083           ENDIF
16f5093311 Jean*0084          ENDIF
cb7fa97db9 Jean*0085 C     apply mask to gW and keep a copy of wVel in gW:
                0086          DO j=1-Oly,sNy+Oly
                0087           DO i=1-Olx,sNx+Olx
                0088             gWtmp(i,j) = gW(i,j,k,bi,bj)
982e105a17 Jean*0089      &             *maskC(i,j,k,bi,bj)*maskC(i,j,km1,bi,bj)
cb7fa97db9 Jean*0090             gW(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)
52c561f327 Jean*0091           ENDDO
                0092          ENDDO
cb7fa97db9 Jean*0093 C     Step forward vertical velocity
f056be794c Jean*0094          tmpFac = nh_Fac + igwFac*wUnit2rVel(k)*wUnit2rVel(k)
                0095      &                           *dBdrRef(k)*deltaTMom*dTtracerLev(k)
cb7fa97db9 Jean*0096          IF (tmpFac.GT.0. ) tmpFac = 1. _d 0 / tmpFac
52c561f327 Jean*0097          DO j=jMin,jMax
                0098           DO i=iMin,iMax
                0099             wVel(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)
cb7fa97db9 Jean*0100      &                        + deltaTmom*tmpFac*gWtmp(i,j)
52c561f327 Jean*0101           ENDDO
                0102          ENDDO
                0103
                0104 C-    End of k loop
                0105         ENDDO
                0106
                0107 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0108
aab550ebd0 Jean*0109       ELSEIF ( implicitIntGravWave ) THEN
cb7fa97db9 Jean*0110 C     keep a copy of wVel in gW:
                0111         DO k=1,Nr
                0112          DO j=1-Oly,sNy+Oly
                0113           DO i=1-Olx,sNx+Olx
                0114             gW(i,j,k,bi,bj) = wVel(i,j,k,bi,bj)
                0115           ENDDO
                0116          ENDDO
                0117         ENDDO
                0118
                0119 C-    End if nonHydrostatic / elseif implicitIntGravWave
aab550ebd0 Jean*0120       ENDIF
52c561f327 Jean*0121
                0122 #endif /* ALLOW_NONHYDROSTATIC */
                0123
                0124       RETURN
                0125       END