pkg/aim_v23/aim_tendency_apply.F

d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
                0002
10308cbe80 Jean*0003 C--  File aim_tendency_apply.F: Routines to Add AIM tendency contributions
                0004 C--   Contents
                0005 C--   o AIM_TENDENCY_APPLY_U
                0006 C--   o AIM_TENDENCY_APPLY_V
                0007 C--   o AIM_TENDENCY_APPLY_T
                0008 C--   o AIM_TENDENCY_APPLY_S
                0009
                0010 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7a648a6f78 Jean*0011 CBOP
                0012 C     !ROUTINE: AIM_TENDENCY_APPLY_U
                0013 C     !INTERFACE:
d676f916b2 Jean*0014       SUBROUTINE AIM_TENDENCY_APPLY_U(
73b1dccda0 Jean*0015      U                        gU_arr,
                0016      I                        iMin,iMax,jMin,jMax, k, bi, bj,
                0017      I                        myTime, myIter, myThid )
7a648a6f78 Jean*0018 C     !DESCRIPTION: \bv
d676f916b2 Jean*0019 C     *==========================================================*
                0020 C     | S/R AIM_TENDENCY_APPLY_U
                0021 C     | o Add AIM tendency terms to U tendency.
                0022 C     *==========================================================*
7a648a6f78 Jean*0023 C     \ev
                0024
                0025 C     !USES:
d676f916b2 Jean*0026       IMPLICIT NONE
                0027
                0028 C     == Global data ==
                0029 #include "SIZE.h"
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032 #include "GRID.h"
                0033 #include "DYNVARS.h"
7a648a6f78 Jean*0034 #ifdef ALLOW_FRICTION_HEATING
                0035 # include "FFIELDS.h"
                0036 #endif
d676f916b2 Jean*0037
299f32bec2 Jean*0038 #include "AIM_PARAMS.h"
d676f916b2 Jean*0039 #include "AIM2DYN.h"
10308cbe80 Jean*0040 #include "AIM_TAVE.h"
d676f916b2 Jean*0041
7a648a6f78 Jean*0042 C     !INPUT/OUTPUT PARAMETERS:
73b1dccda0 Jean*0043 C     gU_arr    :: the tendency array
                0044 C     iMin,iMax :: Working range of x-index for applying forcing.
                0045 C     jMin,jMax :: Working range of y-index for applying forcing.
                0046 C     k         :: Current vertical level index
                0047 C     bi,bj     :: Current tile indices
7a648a6f78 Jean*0048 C     myTime    :: Current time in simulation
73b1dccda0 Jean*0049 C     myIter    :: Current iteration number
7a648a6f78 Jean*0050 C     myThid    :: my Thread Id number
73b1dccda0 Jean*0051       _RL     gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0052       INTEGER iMin, iMax, jMin, jMax
                0053       INTEGER k, bi, bj
                0054       _RL     myTime
                0055       INTEGER myIter
d676f916b2 Jean*0056       INTEGER myThid
7a648a6f78 Jean*0057 CEOP
d676f916b2 Jean*0058
                0059 #ifdef ALLOW_AIM
b407ffd59d Jean*0060 C     == Local variables in common block ==
7a648a6f78 Jean*0061 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
10308cbe80 Jean*0062 C     aim_uStress :: surface stress applied to zonal wind
1bc0e5d60a Davi*0063       COMMON /LOCAL_AIM_TENDENCY_APPLY_U/ aim_uStress,aim_KEuStr
7a648a6f78 Jean*0064       _RL aim_uStress(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0065       _RL aim_KEuStr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0066 #endif
10308cbe80 Jean*0067
d676f916b2 Jean*0068 C     == Local variables ==
7a648a6f78 Jean*0069 C     i,j  :: Loop counters
d676f916b2 Jean*0070       INTEGER i, j
7a648a6f78 Jean*0071       _RL uStr_tmp
                0072 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0073       _RL aim_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0074 #endif
d676f916b2 Jean*0075
7a648a6f78 Jean*0076 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
                0077       IF ( myTime.EQ.startTime .AND. k.EQ.1 ) THEN
b407ffd59d Jean*0078 C-    Initialise diagnostic array aim_uStress
7a648a6f78 Jean*0079        DO j=1-OLy,sNy+OLy
                0080         DO i=1-OLx,sNx+OLx
b407ffd59d Jean*0081          aim_uStress(i,j,bi,bj) = 0.
1bc0e5d60a Davi*0082          aim_KEuStr(i,j,bi,bj)  = 0.
b407ffd59d Jean*0083         ENDDO
                0084        ENDDO
                0085       ENDIF
7a648a6f78 Jean*0086 #endif
b407ffd59d Jean*0087
10308cbe80 Jean*0088 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7a648a6f78 Jean*0089       IF ( k.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN
10308cbe80 Jean*0090 C- Note: exclusive IF / ELSE is legitimate here since surface drag
299f32bec2 Jean*0091 C        is not supposed to be applied in stratosphere
d676f916b2 Jean*0092        DO j=jMin,jMax
                0093         DO i=iMin,iMax
73b1dccda0 Jean*0094           gU_arr(i,j) = gU_arr(i,j)
7a648a6f78 Jean*0095      &     -maskW(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)/aim_dragStrato
                0096 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0097           aim_dKE(i,j) =
b0521bd135 Jean*0098      &     -uVel(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)/aim_dragStrato
                0099      &                       *hFacW(i,j,k,bi,bj)*drF(k)*rUnit2mass
7a648a6f78 Jean*0100 #endif
299f32bec2 Jean*0101         ENDDO
                0102        ENDDO
7a648a6f78 Jean*0103       ELSEIF ( k.EQ.1 ) THEN
299f32bec2 Jean*0104        DO j=jMin,jMax
                0105         DO i=iMin,iMax
7a648a6f78 Jean*0106          IF ( maskW(i,j,k,bi,bj) .NE. 0. ) THEN
10308cbe80 Jean*0107           uStr_tmp =
d676f916b2 Jean*0108      &     -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
7a648a6f78 Jean*0109      &       * 0.5 _d 0 * uVel(i,j,k,bi,bj)
73b1dccda0 Jean*0110           gU_arr(i,j) = gU_arr(i,j)
                0111      &                + uStr_tmp*gravity*recip_drF(k)
                0112      &                * recip_hFacW(i,j,k,bi,bj)
7a648a6f78 Jean*0113 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
b407ffd59d Jean*0114           aim_uStress(i,j,bi,bj) = uStr_tmp
7a648a6f78 Jean*0115 #endif
ed936f6096 Jean*0116 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0117           aim_dKE(i,j) = uStr_tmp * uVel(i,j,k,bi,bj)
7a648a6f78 Jean*0118          ELSE
                0119           aim_dKE(i,j) = 0.
                0120 #endif
d676f916b2 Jean*0121          ENDIF
                0122         ENDDO
                0123        ENDDO
                0124       ELSE
                0125        DO j=jMin,jMax
                0126         DO i=iMin,iMax
7a648a6f78 Jean*0127          IF ( maskW(i,j,k-1,bi,bj) .EQ. 0.
                0128      &    .AND. maskW(i,j,k,bi,bj) .NE. 0. ) THEN
10308cbe80 Jean*0129           uStr_tmp =
7a648a6f78 Jean*0130      &      -( (1.-maskC(i-1,j,k-1,bi,bj))*aim_drag(i-1,j,bi,bj)
                0131      &        +(1.-maskC( i ,j,k-1,bi,bj))*aim_drag( i ,j,bi,bj)
                0132      &       )* 0.5 _d 0 * uVel(i,j,k,bi,bj)
73b1dccda0 Jean*0133           gU_arr(i,j) = gU_arr(i,j)
                0134      &                + uStr_tmp*gravity*recip_drF(k)
                0135      &                * recip_hFacW(i,j,k,bi,bj)
7a648a6f78 Jean*0136 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
b407ffd59d Jean*0137           aim_uStress(i,j,bi,bj) = uStr_tmp
7a648a6f78 Jean*0138 #endif
ed936f6096 Jean*0139 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0140           aim_dKE(i,j) = uStr_tmp * uVel(i,j,k,bi,bj)
7a648a6f78 Jean*0141          ELSE
                0142           aim_dKE(i,j) = 0.
                0143 #endif
d676f916b2 Jean*0144          ENDIF
                0145         ENDDO
                0146        ENDDO
                0147       ENDIF
10308cbe80 Jean*0148 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d676f916b2 Jean*0149
7a648a6f78 Jean*0150 #ifdef ALLOW_FRICTION_HEATING
                0151       IF ( addFrictionHeating ) THEN
                0152         DO j=1,sNy
                0153          DO i=1,sNx
                0154            frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
e24c9bfc82 Jean*0155      &         - halfRL * ( aim_dKE( i, j)*rAw( i, j,bi,bj)
                0156      &                    + aim_dKE(i+1,j)*rAw(i+1,j,bi,bj)
                0157      &                    )*recip_rA(i,j,bi,bj)
7a648a6f78 Jean*0158          ENDDO
                0159         ENDDO
                0160       ENDIF
                0161 #endif /* ALLOW_FRICTION_HEATING */
b407ffd59d Jean*0162 #ifdef ALLOW_AIM_TAVE
7a648a6f78 Jean*0163       IF ( aim_taveFreq.NE.0 .AND. k.EQ.Nr ) THEN
b407ffd59d Jean*0164         CALL TIMEAVE_CUMULATE( USTRtave, aim_uStress, 1,
7a648a6f78 Jean*0165      &                         deltaTClock, bi, bj, myThid )
b407ffd59d Jean*0166       ENDIF
                0167 #endif
                0168 #ifdef ALLOW_DIAGNOSTICS
ed936f6096 Jean*0169       IF ( usediagnostics ) THEN
                0170        IF ( k.EQ.1 ) THEN
                0171         DO j=jMin,jMax
                0172          DO i=iMin,iMax
                0173           aim_KEuStr(i,j,bi,bj) = aim_dKE(i,j)
                0174          ENDDO
                0175         ENDDO
                0176        ELSE
                0177         DO j=jMin,jMax
                0178          DO i=iMin,iMax
                0179           aim_KEuStr(i,j,bi,bj) = aim_KEuStr(i,j,bi,bj)
                0180      &                          + aim_dKE(i,j)
                0181          ENDDO
                0182         ENDDO
                0183        ENDIF
                0184        IF ( k.EQ.Nr ) THEN
9340658285 Jean*0185         CALL DIAGNOSTICS_FILL( aim_uStress, 'UFLUX   ',
                0186      &                         0,1,1,bi,bj,myThid)
1bc0e5d60a Davi*0187         CALL DIAGNOSTICS_FILL( aim_KEuStr,  'dKE_Ustr',
                0188      &                         0,1,1,bi,bj,myThid)
ed936f6096 Jean*0189        ENDIF
b407ffd59d Jean*0190       ENDIF
ed936f6096 Jean*0191 #endif /* ALLOW_DIAGNOSTICS */
b407ffd59d Jean*0192
d676f916b2 Jean*0193 #endif /* ALLOW_AIM */
                0194
                0195       RETURN
                0196       END
10308cbe80 Jean*0197
                0198 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7a648a6f78 Jean*0199 CBOP
                0200 C     !ROUTINE: AIM_TENDENCY_APPLY_V
                0201 C     !INTERFACE:
d676f916b2 Jean*0202       SUBROUTINE AIM_TENDENCY_APPLY_V(
73b1dccda0 Jean*0203      U                        gV_arr,
                0204      I                        iMin,iMax,jMin,jMax, k, bi, bj,
                0205      I                        myTime, myIter, myThid )
7a648a6f78 Jean*0206 C     !DESCRIPTION: \bv
d676f916b2 Jean*0207 C     *==========================================================*
                0208 C     | S/R TENDENCY_APPLY_V
                0209 C     | o Add AIM tendency terms to V tendency.
                0210 C     *==========================================================*
7a648a6f78 Jean*0211 C     \ev
                0212
                0213 C     !USES:
d676f916b2 Jean*0214       IMPLICIT NONE
                0215
                0216 C     == Global data ==
                0217 #include "SIZE.h"
                0218 #include "EEPARAMS.h"
                0219 #include "PARAMS.h"
                0220 #include "GRID.h"
                0221 #include "DYNVARS.h"
7a648a6f78 Jean*0222 #ifdef ALLOW_FRICTION_HEATING
                0223 # include "FFIELDS.h"
                0224 #endif
d676f916b2 Jean*0225
299f32bec2 Jean*0226 #include "AIM_PARAMS.h"
d676f916b2 Jean*0227 #include "AIM2DYN.h"
10308cbe80 Jean*0228 #include "AIM_TAVE.h"
d676f916b2 Jean*0229
7a648a6f78 Jean*0230 C     !INPUT/OUTPUT PARAMETERS:
73b1dccda0 Jean*0231 C     gV_arr    :: the tendency array
                0232 C     iMin,iMax :: Working range of x-index for applying forcing.
                0233 C     jMin,jMax :: Working range of y-index for applying forcing.
                0234 C     k         :: Current vertical level index
                0235 C     bi,bj     :: Current tile indices
7a648a6f78 Jean*0236 C     myTime    :: Current time in simulation
73b1dccda0 Jean*0237 C     myIter    :: Current iteration number
7a648a6f78 Jean*0238 C     myThid    :: my Thread Id number
73b1dccda0 Jean*0239       _RL     gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0240       INTEGER iMin, iMax, jMin, jMax
                0241       INTEGER k, bi, bj
                0242       _RL     myTime
                0243       INTEGER myIter
d676f916b2 Jean*0244       INTEGER myThid
7a648a6f78 Jean*0245 CEOP
d676f916b2 Jean*0246
                0247 #ifdef ALLOW_AIM
b407ffd59d Jean*0248 C     == Local variables in common block ==
7a648a6f78 Jean*0249 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
                0250 C     aim_vStress :: surface stress applied to meridional wind
1bc0e5d60a Davi*0251       COMMON /LOCAL_AIM_TENDENCY_APPLY_V/ aim_vStress,aim_KEvStr
7a648a6f78 Jean*0252       _RL aim_vStress(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0253       _RL aim_KEvStr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0254 #endif
10308cbe80 Jean*0255
d676f916b2 Jean*0256 C     == Local variables ==
7a648a6f78 Jean*0257 C     i,j  :: Loop counters
d676f916b2 Jean*0258       INTEGER i, j
7a648a6f78 Jean*0259       _RL vStr_tmp
                0260 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0261       _RL aim_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0262 #endif
d676f916b2 Jean*0263
7a648a6f78 Jean*0264 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
                0265       IF ( myTime.EQ.startTime .AND. k.EQ.1 ) THEN
b407ffd59d Jean*0266 C-    Initialise diagnostic array aim_uStress
7a648a6f78 Jean*0267        DO j=1-OLy,sNy+OLy
                0268         DO i=1-OLx,sNx+OLx
b407ffd59d Jean*0269          aim_vStress(i,j,bi,bj) = 0.
1bc0e5d60a Davi*0270          aim_KEvStr(i,j,bi,bj)  = 0.
b407ffd59d Jean*0271         ENDDO
                0272        ENDDO
                0273       ENDIF
7a648a6f78 Jean*0274 #endif
b407ffd59d Jean*0275
10308cbe80 Jean*0276 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7a648a6f78 Jean*0277       IF ( k.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN
10308cbe80 Jean*0278 C- Note: exclusive IF / ELSE is legitimate here since surface drag
299f32bec2 Jean*0279 C        is not supposed to be applied in the stratosphere
                0280        DO j=jMin,jMax
                0281         DO i=iMin,iMax
73b1dccda0 Jean*0282           gV_arr(i,j) = gV_arr(i,j)
7a648a6f78 Jean*0283      &     -maskS(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)/aim_dragStrato
                0284 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0285           aim_dKE(i,j) =
b0521bd135 Jean*0286      &     -vVel(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)/aim_dragStrato
                0287      &                       *hFacS(i,j,k,bi,bj)*drF(k)*rUnit2mass
7a648a6f78 Jean*0288 #endif
299f32bec2 Jean*0289         ENDDO
                0290        ENDDO
7a648a6f78 Jean*0291       ELSEIF ( k.EQ.1 ) THEN
d676f916b2 Jean*0292        DO j=jMin,jMax
                0293         DO i=iMin,iMax
7a648a6f78 Jean*0294          IF ( maskS(i,j,k,bi,bj) .NE. 0. ) THEN
10308cbe80 Jean*0295           vStr_tmp =
d676f916b2 Jean*0296      &     -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
7a648a6f78 Jean*0297      &       * 0.5 _d 0 * vVel(i,j,k,bi,bj)
73b1dccda0 Jean*0298           gV_arr(i,j) = gV_arr(i,j)
                0299      &                + vStr_tmp*gravity*recip_drF(k)
                0300      &                * recip_hFacS(i,j,k,bi,bj)
7a648a6f78 Jean*0301 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
b407ffd59d Jean*0302           aim_vStress(i,j,bi,bj) = vStr_tmp
7a648a6f78 Jean*0303 #endif
ed936f6096 Jean*0304 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0305           aim_dKE(i,j) = vStr_tmp * vVel(i,j,k,bi,bj)
7a648a6f78 Jean*0306          ELSE
                0307           aim_dKE(i,j) = 0.
                0308 #endif
d676f916b2 Jean*0309          ENDIF
                0310         ENDDO
                0311        ENDDO
                0312       ELSE
                0313        DO j=jMin,jMax
                0314         DO i=iMin,iMax
7a648a6f78 Jean*0315          IF ( maskS(i,j,k-1,bi,bj) .EQ. 0.
                0316      &    .AND. maskS(i,j,k,bi,bj) .NE. 0. ) THEN
10308cbe80 Jean*0317           vStr_tmp =
7a648a6f78 Jean*0318      &     -( (1.-maskC(i,j-1,k-1,bi,bj))*aim_drag(i,j-1,bi,bj)
                0319      &       +(1.-maskC(i, j ,k-1,bi,bj))*aim_drag(i, j ,bi,bj)
                0320      &      )* 0.5 _d 0 * vVel(i,j,k,bi,bj)
73b1dccda0 Jean*0321           gV_arr(i,j) = gV_arr(i,j)
                0322      &                + vStr_tmp*gravity*recip_drF(k)
                0323      &                * recip_hFacS(i,j,k,bi,bj)
7a648a6f78 Jean*0324 #if ( defined ALLOW_AIM_TAVE ) || ( defined ALLOW_DIAGNOSTICS )
b407ffd59d Jean*0325           aim_vStress(i,j,bi,bj) = vStr_tmp
7a648a6f78 Jean*0326 #endif
ed936f6096 Jean*0327 #if ( defined ALLOW_FRICTION_HEATING ) || ( defined ALLOW_DIAGNOSTICS )
                0328           aim_dKE(i,j) = vStr_tmp * vVel(i,j,k,bi,bj)
7a648a6f78 Jean*0329          ELSE
                0330           aim_dKE(i,j) = 0.
                0331 #endif
d676f916b2 Jean*0332          ENDIF
                0333         ENDDO
                0334        ENDDO
                0335       ENDIF
10308cbe80 Jean*0336 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d676f916b2 Jean*0337
7a648a6f78 Jean*0338 #ifdef ALLOW_FRICTION_HEATING
                0339       IF ( addFrictionHeating ) THEN
                0340         DO j=1,sNy
                0341          DO i=1,sNx
                0342            frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
e24c9bfc82 Jean*0343      &         - halfRL * ( aim_dKE(i, j )*rAs(i, j, bi,bj)
                0344      &                    + aim_dKE(i,j+1)*rAs(i,j+1,bi,bj)
                0345      &                    )*recip_rA(i,j,bi,bj)
7a648a6f78 Jean*0346          ENDDO
                0347         ENDDO
                0348       ENDIF
                0349 #endif /* ALLOW_FRICTION_HEATING */
b407ffd59d Jean*0350 #ifdef ALLOW_AIM_TAVE
7a648a6f78 Jean*0351       IF ( aim_taveFreq.NE.0 .AND. k.EQ.Nr ) THEN
b407ffd59d Jean*0352         CALL TIMEAVE_CUMULATE( VSTRtave, aim_vStress, 1,
7a648a6f78 Jean*0353      &                         deltaTClock, bi, bj, myThid )
b407ffd59d Jean*0354       ENDIF
                0355 #endif
                0356 #ifdef ALLOW_DIAGNOSTICS
ed936f6096 Jean*0357       IF ( usediagnostics ) THEN
                0358        IF ( k.EQ.1 ) THEN
                0359         DO j=jMin,jMax
                0360          DO i=iMin,iMax
                0361           aim_KEvStr(i,j,bi,bj) = aim_dKE(i,j)
                0362          ENDDO
                0363         ENDDO
                0364        ELSE
                0365         DO j=jMin,jMax
                0366          DO i=iMin,iMax
                0367           aim_KEvStr(i,j,bi,bj) = aim_KEvStr(i,j,bi,bj)
                0368      &                          + aim_dKE(i,j)
                0369          ENDDO
                0370         ENDDO
                0371        ENDIF
                0372        IF ( k.EQ.Nr ) THEN
9340658285 Jean*0373         CALL DIAGNOSTICS_FILL( aim_vStress, 'VFLUX   ',
                0374      &                         0,1,1,bi,bj,myThid)
1bc0e5d60a Davi*0375         CALL DIAGNOSTICS_FILL( aim_KEvStr,  'dKE_Vstr',
                0376      &                         0,1,1,bi,bj,myThid)
ed936f6096 Jean*0377        ENDIF
b407ffd59d Jean*0378       ENDIF
ed936f6096 Jean*0379 #endif /* ALLOW_DIAGNOSTICS */
b407ffd59d Jean*0380
d676f916b2 Jean*0381 #endif /* ALLOW_AIM */
                0382
                0383       RETURN
                0384       END
10308cbe80 Jean*0385
                0386 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7a648a6f78 Jean*0387 CBOP
                0388 C     !ROUTINE: AIM_TENDENCY_APPLY_T
                0389 C     !INTERFACE:
d676f916b2 Jean*0390       SUBROUTINE AIM_TENDENCY_APPLY_T(
73b1dccda0 Jean*0391      U                        gT_arr,
                0392      I                        iMin,iMax,jMin,jMax, k, bi, bj,
                0393      I                        myTime, myIter, myThid )
7a648a6f78 Jean*0394 C     !DESCRIPTION: \bv
d676f916b2 Jean*0395 C     *==========================================================*
                0396 C     | S/R AIM_TENDENCY_APPLY_T
7a648a6f78 Jean*0397 C     | o Add AIM tendency to potential Temp tendency.
d676f916b2 Jean*0398 C     *==========================================================*
7a648a6f78 Jean*0399 C     \ev
                0400
                0401 C     !USES:
d676f916b2 Jean*0402       IMPLICIT NONE
                0403
                0404 C     == Global data ==
                0405 #include "SIZE.h"
                0406 #include "EEPARAMS.h"
                0407 #include "PARAMS.h"
                0408 #include "GRID.h"
73b1dccda0 Jean*0409 c#include "DYNVARS.h"
d676f916b2 Jean*0410
                0411 #include "AIM2DYN.h"
                0412
7a648a6f78 Jean*0413 C     !INPUT/OUTPUT PARAMETERS:
73b1dccda0 Jean*0414 C     gT_arr    :: the tendency array
                0415 C     iMin,iMax :: Working range of x-index for applying forcing.
                0416 C     jMin,jMax :: Working range of y-index for applying forcing.
                0417 C     k         :: Current vertical level index
                0418 C     bi,bj     :: Current tile indices
7a648a6f78 Jean*0419 C     myTime    :: Current time in simulation
73b1dccda0 Jean*0420 C     myIter    :: Current iteration number
7a648a6f78 Jean*0421 C     myThid    :: my Thread Id number
73b1dccda0 Jean*0422       _RL     gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0423       INTEGER iMin, iMax, jMin, jMax
                0424       INTEGER k, bi, bj
                0425       _RL     myTime
                0426       INTEGER myIter
d676f916b2 Jean*0427       INTEGER myThid
7a648a6f78 Jean*0428 CEOP
d676f916b2 Jean*0429
                0430 #ifdef ALLOW_AIM
                0431 C     == Local variables ==
7a648a6f78 Jean*0432 C     i,j  :: Loop counters
d676f916b2 Jean*0433       INTEGER I, J
                0434
                0435 C--   Forcing: add AIM heating/cooling tendency to gT:
                0436       DO J=1,sNy
                0437        DO I=1,sNx
73b1dccda0 Jean*0438         gT_arr(i,j) = maskC(i,j,k,bi,bj)
                0439      &              *( gT_arr(i,j) + aim_dTdt(i,j,k,bi,bj) )
d676f916b2 Jean*0440        ENDDO
                0441       ENDDO
                0442
                0443 #endif /* ALLOW_AIM */
                0444
                0445       RETURN
                0446       END
10308cbe80 Jean*0447
                0448 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7a648a6f78 Jean*0449 CBOP
73b1dccda0 Jean*0450 C     !ROUTINE: AIM_TENDENCY_APPLY_S
7a648a6f78 Jean*0451 C     !INTERFACE:
d676f916b2 Jean*0452       SUBROUTINE AIM_TENDENCY_APPLY_S(
73b1dccda0 Jean*0453      U                        gS_arr,
                0454      I                        iMin,iMax,jMin,jMax, k, bi, bj,
                0455      I                        myTime, myIter, myThid )
7a648a6f78 Jean*0456 C     !DESCRIPTION: \bv
d676f916b2 Jean*0457 C     *==========================================================*
                0458 C     | S/R AIM_TENDENCY_APPLY_S
7a648a6f78 Jean*0459 C     | o Add AIM tendency to Specific Humidity tendency.
d676f916b2 Jean*0460 C     *==========================================================*
7a648a6f78 Jean*0461 C     \ev
                0462
                0463 C     !USES:
d676f916b2 Jean*0464       IMPLICIT NONE
                0465
                0466 C     == Global data ==
                0467 #include "SIZE.h"
                0468 #include "EEPARAMS.h"
                0469 #include "PARAMS.h"
                0470 #include "GRID.h"
73b1dccda0 Jean*0471 c#include "DYNVARS.h"
d676f916b2 Jean*0472
                0473 #include "AIM2DYN.h"
                0474
7a648a6f78 Jean*0475 C     !INPUT/OUTPUT PARAMETERS:
73b1dccda0 Jean*0476 C     gS_arr    :: the tendency array
                0477 C     iMin,iMax :: Working range of x-index for applying forcing.
                0478 C     jMin,jMax :: Working range of y-index for applying forcing.
                0479 C     k         :: Current vertical level index
                0480 C     bi,bj     :: Current tile indices
7a648a6f78 Jean*0481 C     myTime    :: Current time in simulation
73b1dccda0 Jean*0482 C     myIter    :: Current iteration number
7a648a6f78 Jean*0483 C     myThid    :: my Thread Id number
73b1dccda0 Jean*0484       _RL     gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0485       INTEGER iMin, iMax, jMin, jMax
                0486       INTEGER k, bi, bj
                0487       _RL     myTime
                0488       INTEGER myIter
d676f916b2 Jean*0489       INTEGER myThid
7a648a6f78 Jean*0490 CEOP
d676f916b2 Jean*0491
                0492 #ifdef ALLOW_AIM
                0493 C     == Local variables ==
7a648a6f78 Jean*0494 C     i,j  :: Loop counters
d676f916b2 Jean*0495       INTEGER I, J
                0496
                0497 C--   Forcing: add AIM dq/dt tendency to gS:
                0498       DO J=1,sNy
                0499        DO I=1,sNx
73b1dccda0 Jean*0500         gS_arr(i,j) = maskC(i,j,k,bi,bj)
                0501      &              *( gS_arr(i,j) + aim_dSdt(i,j,k,bi,bj) )
d676f916b2 Jean*0502        ENDDO
                0503       ENDDO
                0504
                0505 #endif /* ALLOW_AIM */
                0506
                0507       RETURN
                0508       END