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