pkg/atm_phys/atm_phys_tendency_apply.F

b2ea1d2979 Jean*0001 #include "ATM_PHYS_OPTIONS.h"
                0002 C--  File atm_phys_tendency_apply.F: Routines to apply ATM_PHYS tendencies
                0003 C--   Contents
                0004 C--   o ATM_PHYS_TENDENCY_APPLY_U
                0005 C--   o ATM_PHYS_TENDENCY_APPLY_V
                0006 C--   o ATM_PHYS_TENDENCY_APPLY_T
                0007 C--   o ATM_PHYS_TENDENCY_APPLY_S
                0008
                0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0010 CBOP 0
                0011 C !ROUTINE: ATM_PHYS_TENDENCY_APPLY_U
                0012
                0013 C !INTERFACE:
                0014       SUBROUTINE ATM_PHYS_TENDENCY_APPLY_U(
73b1dccda0 Jean*0015      U                    gU_arr,
                0016      I                    iMin,iMax,jMin,jMax, k, bi, bj,
                0017      I                    myTime, myIter, myThid )
b2ea1d2979 Jean*0018
                0019 C     !DESCRIPTION:
                0020 C     Add AtmPhys tendency terms to U tendency.  Routine works for one
                0021 C     level at a time. Assumes that U and V tendencies are on A-Grid
                0022
                0023 C     !USES:
                0024       IMPLICIT NONE
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
0d5d00bd7f Jean*0027 #include "PARAMS.h"
                0028 #include "GRID.h"
b2ea1d2979 Jean*0029 #include "DYNVARS.h"
0d5d00bd7f Jean*0030 #include "FFIELDS.h"
b2ea1d2979 Jean*0031 #include "ATM_PHYS_PARAMS.h"
                0032 #include "ATM_PHYS_VARS.h"
                0033
73b1dccda0 Jean*0034 C     !INPUT/OUTPUT PARAMETERS:
                0035 C     gU_arr    :: the tendency array
                0036 C     iMin,iMax :: Working range of x-index for applying forcing.
                0037 C     jMin,jMax :: Working range of y-index for applying forcing.
                0038 C     k         :: Current vertical level index
                0039 C     bi,bj     :: Current tile indices
                0040 C     myTime    :: Current time in simulation
                0041 C     myIter    :: Current iteration number
                0042 C     myThid    :: my Thread Id number
                0043       _RL     gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0044       INTEGER iMin, iMax, jMin, jMax
                0045       INTEGER k, bi, bj
                0046       _RL     myTime
                0047       INTEGER myIter
                0048       INTEGER myThid
b2ea1d2979 Jean*0049 CEOP
                0050
                0051 C     !LOCAL VARIABLES:
                0052       INTEGER i, j
0d5d00bd7f Jean*0053       _RL damp_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
b2ea1d2979 Jean*0054
                0055       IF ( atmPhys_addTendU ) THEN
0d5d00bd7f Jean*0056
b2ea1d2979 Jean*0057 C--   Assume Agrid position:
                0058         DO j=jMin,jMax
                0059          DO i=iMin,iMax
73b1dccda0 Jean*0060           gU_arr(i,j) = gU_arr(i,j)
55a26a1b95 Jean*0061      &      + halfRL *( atmPhys_dU(i-1,j,k,bi,bj)
                0062      &                + atmPhys_dU( i ,j,k,bi,bj)
                0063      &                )*recip_hFacW(i,j,k,bi,bj)
                0064 c    &                )*maskW(i,j,k,bi,bj)
b2ea1d2979 Jean*0065          ENDDO
                0066         ENDDO
0d5d00bd7f Jean*0067
                0068        IF ( atmPhys_dampUVfac(k).GT.zeroRL ) THEN
                0069         DO j=jMin,jMax
                0070          DO i=iMin,iMax
73b1dccda0 Jean*0071           gU_arr(i,j) = gU_arr(i,j)
0d5d00bd7f Jean*0072      &     - maskW(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
                0073           damp_dKE(i,j) =
                0074      &     - uVel(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
                0075      &                       *hFacW(i,j,k,bi,bj)*drF(k)*rUnit2mass
                0076          ENDDO
                0077         ENDDO
                0078 #ifdef ALLOW_FRICTION_HEATING
                0079         IF ( addFrictionHeating ) THEN
                0080          DO j=1,sNy
                0081           DO i=1,sNx
                0082            frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
e24c9bfc82 Jean*0083      &         - halfRL * ( damp_dKE( i, j)*rAw( i, j,bi,bj)
                0084      &                    + damp_dKE(i+1,j)*rAw(i+1,j,bi,bj)
                0085      &                    )*recip_rA(i,j,bi,bj)
0d5d00bd7f Jean*0086           ENDDO
                0087          ENDDO
                0088         ENDIF
                0089 #endif /* ALLOW_FRICTION_HEATING */
                0090        ENDIF
                0091
b2ea1d2979 Jean*0092       ENDIF
                0093
                0094       RETURN
                0095       END
                0096
                0097 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0098 CBOP 0
                0099 C !ROUTINE: ATM_PHYS_TENDENCY_APPLY_V
                0100
                0101 C !INTERFACE:
                0102       SUBROUTINE ATM_PHYS_TENDENCY_APPLY_V(
73b1dccda0 Jean*0103      U                    gV_arr,
                0104      I                    iMin,iMax,jMin,jMax, k, bi, bj,
                0105      I                    myTime, myIter, myThid )
b2ea1d2979 Jean*0106
                0107 C     !DESCRIPTION:
                0108 C     Add AtmPhys tendency terms to V tendency.  Routine works for one
                0109 C     level at a time. Assumes that U and V tendencies are on A-Grid
                0110
                0111 C     !USES:
                0112       IMPLICIT NONE
                0113 #include "SIZE.h"
                0114 #include "EEPARAMS.h"
0d5d00bd7f Jean*0115 #include "PARAMS.h"
                0116 #include "GRID.h"
b2ea1d2979 Jean*0117 #include "DYNVARS.h"
0d5d00bd7f Jean*0118 #include "FFIELDS.h"
b2ea1d2979 Jean*0119 #include "ATM_PHYS_PARAMS.h"
                0120 #include "ATM_PHYS_VARS.h"
                0121
73b1dccda0 Jean*0122 C     !INPUT/OUTPUT PARAMETERS:
                0123 C     gV_arr    :: the tendency array
                0124 C     iMin,iMax :: Working range of x-index for applying forcing.
                0125 C     jMin,jMax :: Working range of y-index for applying forcing.
                0126 C     k         :: Current vertical level index
                0127 C     bi,bj     :: Current tile indices
                0128 C     myTime    :: Current time in simulation
                0129 C     myIter    :: Current iteration number
                0130 C     myThid    :: my Thread Id number
                0131       _RL     gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0132       INTEGER iMin, iMax, jMin, jMax
                0133       INTEGER k, bi, bj
                0134       _RL     myTime
                0135       INTEGER myIter
                0136       INTEGER myThid
b2ea1d2979 Jean*0137 CEOP
                0138
                0139 C     !LOCAL VARIABLES:
                0140       INTEGER i, j
0d5d00bd7f Jean*0141       _RL damp_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
b2ea1d2979 Jean*0142
                0143       IF ( atmPhys_addTendV ) THEN
0d5d00bd7f Jean*0144
b2ea1d2979 Jean*0145 C--   Assume Agrid position:
                0146         DO j=jMin,jMax
                0147          DO i=iMin,iMax
73b1dccda0 Jean*0148           gV_arr(i,j) = gV_arr(i,j)
55a26a1b95 Jean*0149      &      + halfRL *( atmPhys_dV(i,j-1,k,bi,bj)
                0150      &                + atmPhys_dV(i, j ,k,bi,bj)
                0151      &                )*recip_hFacS(i,j,k,bi,bj)
                0152 c    &                )*maskS(i,j,k,bi,bj)
b2ea1d2979 Jean*0153          ENDDO
                0154         ENDDO
0d5d00bd7f Jean*0155
                0156        IF ( atmPhys_dampUVfac(k).GT.zeroRL ) THEN
                0157         DO j=jMin,jMax
                0158          DO i=iMin,iMax
73b1dccda0 Jean*0159           gV_arr(i,j) = gV_arr(i,j)
0d5d00bd7f Jean*0160      &     - maskS(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
                0161           damp_dKE(i,j) =
                0162      &     - vVel(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)*atmPhys_dampUVfac(k)
                0163      &                        *hFacS(i,j,k,bi,bj)*drF(k)*rUnit2mass
                0164          ENDDO
                0165         ENDDO
                0166 #ifdef ALLOW_FRICTION_HEATING
                0167         IF ( addFrictionHeating ) THEN
                0168          DO j=1,sNy
                0169           DO i=1,sNx
                0170            frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
e24c9bfc82 Jean*0171      &         - halfRL * ( damp_dKE( i, j)*rAs(i, j ,bi,bj)
35a4256c85 Jean*0172      &                    + damp_dKE(i,j+1)*rAs(i,j+1,bi,bj)
e24c9bfc82 Jean*0173      &                    )*recip_rA(i,j,bi,bj)
0d5d00bd7f Jean*0174           ENDDO
                0175          ENDDO
                0176         ENDIF
                0177 #endif /* ALLOW_FRICTION_HEATING */
                0178        ENDIF
                0179
b2ea1d2979 Jean*0180       ENDIF
                0181
                0182       RETURN
                0183       END
                0184
                0185 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0186 CBOP 0
                0187 C !ROUTINE: ATM_PHYS_TENDENCY_APPLY_T
                0188
                0189 C !INTERFACE:
                0190       SUBROUTINE ATM_PHYS_TENDENCY_APPLY_T(
73b1dccda0 Jean*0191      U                    gT_arr,
                0192      I                    iMin,iMax,jMin,jMax, k, bi, bj,
                0193      I                    myTime, myIter, myThid )
b2ea1d2979 Jean*0194
                0195 C     !DESCRIPTION:
                0196 C     Add AtmPhys tendency terms to T (theta) tendency.  Routine works
                0197 C     for one level at a time
                0198
                0199 C     !USES:
                0200       IMPLICIT NONE
                0201 #include "SIZE.h"
                0202 #include "GRID.h"
                0203 #include "EEPARAMS.h"
73b1dccda0 Jean*0204 c#include "DYNVARS.h"
b2ea1d2979 Jean*0205 #include "ATM_PHYS_PARAMS.h"
                0206 #include "ATM_PHYS_VARS.h"
                0207
73b1dccda0 Jean*0208 C     !INPUT/OUTPUT PARAMETERS:
                0209 C     gT_arr    :: the tendency array
                0210 C     iMin,iMax :: Working range of x-index for applying forcing.
                0211 C     jMin,jMax :: Working range of y-index for applying forcing.
                0212 C     k         :: Current vertical level index
                0213 C     bi,bj     :: Current tile indices
                0214 C     myTime    :: Current time in simulation
                0215 C     myIter    :: Current iteration number
                0216 C     myThid    :: my Thread Id number
                0217       _RL     gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0218       INTEGER iMin, iMax, jMin, jMax
                0219       INTEGER k, bi, bj
                0220       _RL     myTime
                0221       INTEGER myIter
                0222       INTEGER myThid
b2ea1d2979 Jean*0223 CEOP
                0224
                0225 C     !LOCAL VARIABLES:
                0226       INTEGER i, j
                0227
                0228       IF ( atmPhys_addTendT ) THEN
                0229         DO j=jMin,jMax
                0230          DO i=iMin,iMax
73b1dccda0 Jean*0231           gT_arr(i,j) = gT_arr(i,j)
b2ea1d2979 Jean*0232      &     + maskC(i,j,k,bi,bj) * atmPhys_dT(i,j,k,bi,bj)
                0233          ENDDO
                0234         ENDDO
                0235       ENDIF
                0236
                0237       RETURN
                0238       END
                0239
                0240 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0241 CBOP 0
                0242 C !ROUTINE: ATM_PHYS_TENDENCY_APPLY_S
                0243
                0244 C !INTERFACE:
                0245       SUBROUTINE ATM_PHYS_TENDENCY_APPLY_S(
73b1dccda0 Jean*0246      U                    gS_arr,
                0247      I                    iMin,iMax,jMin,jMax, k, bi, bj,
                0248      I                    myTime, myIter, myThid )
b2ea1d2979 Jean*0249
                0250 C     !DESCRIPTION:
                0251 C     Add AtmPhys tendency terms to S tendency.  Routine works for one
                0252 C     level at a time
                0253
73b1dccda0 Jean*0254 C     !USES:
b2ea1d2979 Jean*0255       IMPLICIT NONE
                0256 #include "SIZE.h"
                0257 #include "GRID.h"
                0258 #include "EEPARAMS.h"
73b1dccda0 Jean*0259 c#include "DYNVARS.h"
b2ea1d2979 Jean*0260 #include "ATM_PHYS_PARAMS.h"
                0261 #include "ATM_PHYS_VARS.h"
                0262
73b1dccda0 Jean*0263 C     !INPUT/OUTPUT PARAMETERS:
                0264 C     gS_arr    :: the tendency array
                0265 C     iMin,iMax :: Working range of x-index for applying forcing.
                0266 C     jMin,jMax :: Working range of y-index for applying forcing.
                0267 C     k         :: Current vertical level index
                0268 C     bi,bj     :: Current tile indices
                0269 C     myTime    :: Current time in simulation
                0270 C     myIter    :: Current iteration number
                0271 C     myThid    :: my Thread Id number
                0272       _RL     gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0273       INTEGER iMin, iMax, jMin, jMax
                0274       INTEGER k, bi, bj
                0275       _RL     myTime
                0276       INTEGER myIter
                0277       INTEGER myThid
b2ea1d2979 Jean*0278 CEOP
                0279
                0280 C     !LOCAL VARIABLES:
                0281       INTEGER i, j
                0282
                0283       IF ( atmPhys_addTendS ) THEN
                0284         DO j=jMin,jMax
                0285          DO i=iMin,iMax
73b1dccda0 Jean*0286           gS_arr(i,j) = gS_arr(i,j)
b2ea1d2979 Jean*0287      &     + maskC(i,j,k,bi,bj) * atmPhys_dQ(i,j,k,bi,bj)
                0288          ENDDO
                0289         ENDDO
                0290       ENDIF
                0291
                0292       RETURN
                0293       END