C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_tendency_apply.F,v 1.14 2015/01/21 14:36:01 jmc Exp $
C $Name: $
#include "AIM_OPTIONS.h"
C-- File aim_tendency_apply.F: Routines to Add AIM tendency contributions
C-- Contents
C-- o AIM_TENDENCY_APPLY_U
C-- o AIM_TENDENCY_APPLY_V
C-- o AIM_TENDENCY_APPLY_T
C-- o AIM_TENDENCY_APPLY_S
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: AIM_TENDENCY_APPLY_U
C !INTERFACE:
SUBROUTINE AIM_TENDENCY_APPLY_U(
U gU_arr,
I iMin,iMax,jMin,jMax, k, bi, bj,
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R AIM_TENDENCY_APPLY_U
C | o Add AIM tendency terms to U tendency.
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#ifdef ALLOW_FRICTION_HEATING
# include "FFIELDS.h"
#endif
#include "AIM_PARAMS.h"
#include "AIM2DYN.h"
#include "AIM_TAVE.h"
C !INPUT/OUTPUT PARAMETERS:
C gU_arr :: the tendency array
C iMin,iMax :: Working range of x-index for applying forcing.
C jMin,jMax :: Working range of y-index for applying forcing.
C k :: Current vertical level index
C bi,bj :: Current tile indices
C myTime :: Current time in simulation
C myIter :: Current iteration number
C myThid :: my Thread Id number
_RL gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER k, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
CEOP
#ifdef ALLOW_AIM
C == Local variables in common block ==
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
C aim_uStress :: surface stress applied to zonal wind
COMMON /LOCAL_AIM_TENDENCY_APPLY_U/ aim_uStress,aim_KEuStr
_RL aim_uStress(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RL aim_KEuStr (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
#endif
C == Local variables ==
C i,j :: Loop counters
INTEGER i, j
_RL uStr_tmp
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
_RL aim_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#endif
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
IF ( myTime.EQ.startTime .AND. k.EQ.1 ) THEN
C- Initialise diagnostic array aim_uStress
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
aim_uStress(i,j,bi,bj) = 0.
aim_KEuStr(i,j,bi,bj) = 0.
ENDDO
ENDDO
ENDIF
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( k.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN
C- Note: exclusive IF / ELSE is legitimate here since surface drag
C is not supposed to be applied in stratosphere
DO j=jMin,jMax
DO i=iMin,iMax
gU_arr(i,j) = gU_arr(i,j)
& -maskW(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)/aim_dragStrato
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
aim_dKE(i,j) =
& -uVel(i,j,k,bi,bj)*uVel(i,j,k,bi,bj)/aim_dragStrato
& *hFacW(i,j,k,bi,bj)*drF(k)*rUnit2mass
#endif
ENDDO
ENDDO
ELSEIF ( k.EQ.1 ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
IF ( maskW(i,j,k,bi,bj) .NE. 0. ) THEN
uStr_tmp =
& -( aim_drag(i-1,j,bi,bj)+aim_drag(i,j,bi,bj) )
& * 0.5 _d 0 * uVel(i,j,k,bi,bj)
gU_arr(i,j) = gU_arr(i,j)
& + uStr_tmp*gravity*recip_drF(k)
& * recip_hFacW(i,j,k,bi,bj)
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
aim_uStress(i,j,bi,bj) = uStr_tmp
#endif
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
aim_dKE(i,j) = uStr_tmp * uVel(i,j,k,bi,bj)
ELSE
aim_dKE(i,j) = 0.
#endif
ENDIF
ENDDO
ENDDO
ELSE
DO j=jMin,jMax
DO i=iMin,iMax
IF ( maskW(i,j,k-1,bi,bj) .EQ. 0.
& .AND. maskW(i,j,k,bi,bj) .NE. 0. ) THEN
uStr_tmp =
& -( (1.-maskC(i-1,j,k-1,bi,bj))*aim_drag(i-1,j,bi,bj)
& +(1.-maskC( i ,j,k-1,bi,bj))*aim_drag( i ,j,bi,bj)
& )* 0.5 _d 0 * uVel(i,j,k,bi,bj)
gU_arr(i,j) = gU_arr(i,j)
& + uStr_tmp*gravity*recip_drF(k)
& * recip_hFacW(i,j,k,bi,bj)
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
aim_uStress(i,j,bi,bj) = uStr_tmp
#endif
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
aim_dKE(i,j) = uStr_tmp * uVel(i,j,k,bi,bj)
ELSE
aim_dKE(i,j) = 0.
#endif
ENDIF
ENDDO
ENDDO
ENDIF
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#ifdef ALLOW_FRICTION_HEATING
IF ( addFrictionHeating ) THEN
DO j=1,sNy
DO i=1,sNx
frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
& - halfRL * ( aim_dKE( i, j)*rAw( i, j,bi,bj)
& + aim_dKE(i+1,j)*rAw(i+1,j,bi,bj)
& )*recip_rA(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
#endif /* ALLOW_FRICTION_HEATING */
#ifdef ALLOW_AIM_TAVE
IF ( aim_taveFreq.NE.0 .AND. k.EQ.Nr ) THEN
CALL TIMEAVE_CUMULATE( USTRtave, aim_uStress, 1,
& deltaTClock, bi, bj, myThid )
ENDIF
#endif
#ifdef ALLOW_DIAGNOSTICS
IF ( usediagnostics ) THEN
IF ( k.EQ.1 ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
aim_KEuStr(i,j,bi,bj) = aim_dKE(i,j)
ENDDO
ENDDO
ELSE
DO j=jMin,jMax
DO i=iMin,iMax
aim_KEuStr(i,j,bi,bj) = aim_KEuStr(i,j,bi,bj)
& + aim_dKE(i,j)
ENDDO
ENDDO
ENDIF
IF ( k.EQ.Nr ) THEN
CALL DIAGNOSTICS_FILL( aim_uStress, 'UFLUX ',
& 0,1,1,bi,bj,myThid)
CALL DIAGNOSTICS_FILL( aim_KEuStr, 'dKE_Ustr',
& 0,1,1,bi,bj,myThid)
ENDIF
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
#endif /* ALLOW_AIM */
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: AIM_TENDENCY_APPLY_V
C !INTERFACE:
SUBROUTINE AIM_TENDENCY_APPLY_V(
U gV_arr,
I iMin,iMax,jMin,jMax, k, bi, bj,
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R TENDENCY_APPLY_V
C | o Add AIM tendency terms to V tendency.
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#ifdef ALLOW_FRICTION_HEATING
# include "FFIELDS.h"
#endif
#include "AIM_PARAMS.h"
#include "AIM2DYN.h"
#include "AIM_TAVE.h"
C !INPUT/OUTPUT PARAMETERS:
C gV_arr :: the tendency array
C iMin,iMax :: Working range of x-index for applying forcing.
C jMin,jMax :: Working range of y-index for applying forcing.
C k :: Current vertical level index
C bi,bj :: Current tile indices
C myTime :: Current time in simulation
C myIter :: Current iteration number
C myThid :: my Thread Id number
_RL gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER k, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
CEOP
#ifdef ALLOW_AIM
C == Local variables in common block ==
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
C aim_vStress :: surface stress applied to meridional wind
COMMON /LOCAL_AIM_TENDENCY_APPLY_V/ aim_vStress,aim_KEvStr
_RL aim_vStress(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
_RL aim_KEvStr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
#endif
C == Local variables ==
C i,j :: Loop counters
INTEGER i, j
_RL vStr_tmp
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
_RL aim_dKE(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
#endif
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
IF ( myTime.EQ.startTime .AND. k.EQ.1 ) THEN
C- Initialise diagnostic array aim_uStress
DO j=1-OLy,sNy+OLy
DO i=1-OLx,sNx+OLx
aim_vStress(i,j,bi,bj) = 0.
aim_KEvStr(i,j,bi,bj) = 0.
ENDDO
ENDDO
ENDIF
#endif
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( k.EQ.Nr .AND. aim_dragStrato.GT.0. ) THEN
C- Note: exclusive IF / ELSE is legitimate here since surface drag
C is not supposed to be applied in the stratosphere
DO j=jMin,jMax
DO i=iMin,iMax
gV_arr(i,j) = gV_arr(i,j)
& -maskS(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)/aim_dragStrato
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
aim_dKE(i,j) =
& -vVel(i,j,k,bi,bj)*vVel(i,j,k,bi,bj)/aim_dragStrato
& *hFacS(i,j,k,bi,bj)*drF(k)*rUnit2mass
#endif
ENDDO
ENDDO
ELSEIF ( k.EQ.1 ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
IF ( maskS(i,j,k,bi,bj) .NE. 0. ) THEN
vStr_tmp =
& -( aim_drag(i,j-1,bi,bj)+aim_drag(i,j,bi,bj) )
& * 0.5 _d 0 * vVel(i,j,k,bi,bj)
gV_arr(i,j) = gV_arr(i,j)
& + vStr_tmp*gravity*recip_drF(k)
& * recip_hFacS(i,j,k,bi,bj)
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
aim_vStress(i,j,bi,bj) = vStr_tmp
#endif
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
aim_dKE(i,j) = vStr_tmp * vVel(i,j,k,bi,bj)
ELSE
aim_dKE(i,j) = 0.
#endif
ENDIF
ENDDO
ENDDO
ELSE
DO j=jMin,jMax
DO i=iMin,iMax
IF ( maskS(i,j,k-1,bi,bj) .EQ. 0.
& .AND. maskS(i,j,k,bi,bj) .NE. 0. ) THEN
vStr_tmp =
& -( (1.-maskC(i,j-1,k-1,bi,bj))*aim_drag(i,j-1,bi,bj)
& +(1.-maskC(i, j ,k-1,bi,bj))*aim_drag(i, j ,bi,bj)
& )* 0.5 _d 0 * vVel(i,j,k,bi,bj)
gV_arr(i,j) = gV_arr(i,j)
& + vStr_tmp*gravity*recip_drF(k)
& * recip_hFacS(i,j,k,bi,bj)
#if ( defined ALLOW_AIM_TAVE ) ( defined ALLOW_DIAGNOSTICS )
aim_vStress(i,j,bi,bj) = vStr_tmp
#endif
#if ( defined ALLOW_FRICTION_HEATING ) ( defined ALLOW_DIAGNOSTICS )
aim_dKE(i,j) = vStr_tmp * vVel(i,j,k,bi,bj)
ELSE
aim_dKE(i,j) = 0.
#endif
ENDIF
ENDDO
ENDDO
ENDIF
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#ifdef ALLOW_FRICTION_HEATING
IF ( addFrictionHeating ) THEN
DO j=1,sNy
DO i=1,sNx
frictionHeating(i,j,k,bi,bj) = frictionHeating(i,j,k,bi,bj)
& - halfRL * ( aim_dKE(i, j )*rAs(i, j, bi,bj)
& + aim_dKE(i,j+1)*rAs(i,j+1,bi,bj)
& )*recip_rA(i,j,bi,bj)
ENDDO
ENDDO
ENDIF
#endif /* ALLOW_FRICTION_HEATING */
#ifdef ALLOW_AIM_TAVE
IF ( aim_taveFreq.NE.0 .AND. k.EQ.Nr ) THEN
CALL TIMEAVE_CUMULATE( VSTRtave, aim_vStress, 1,
& deltaTClock, bi, bj, myThid )
ENDIF
#endif
#ifdef ALLOW_DIAGNOSTICS
IF ( usediagnostics ) THEN
IF ( k.EQ.1 ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
aim_KEvStr(i,j,bi,bj) = aim_dKE(i,j)
ENDDO
ENDDO
ELSE
DO j=jMin,jMax
DO i=iMin,iMax
aim_KEvStr(i,j,bi,bj) = aim_KEvStr(i,j,bi,bj)
& + aim_dKE(i,j)
ENDDO
ENDDO
ENDIF
IF ( k.EQ.Nr ) THEN
CALL DIAGNOSTICS_FILL( aim_vStress, 'VFLUX ',
& 0,1,1,bi,bj,myThid)
CALL DIAGNOSTICS_FILL( aim_KEvStr, 'dKE_Vstr',
& 0,1,1,bi,bj,myThid)
ENDIF
ENDIF
#endif /* ALLOW_DIAGNOSTICS */
#endif /* ALLOW_AIM */
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: AIM_TENDENCY_APPLY_T
C !INTERFACE:
SUBROUTINE AIM_TENDENCY_APPLY_T(
U gT_arr,
I iMin,iMax,jMin,jMax, k, bi, bj,
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R AIM_TENDENCY_APPLY_T
C | o Add AIM tendency to potential Temp tendency.
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
c#include "DYNVARS.h"
#include "AIM2DYN.h"
C !INPUT/OUTPUT PARAMETERS:
C gT_arr :: the tendency array
C iMin,iMax :: Working range of x-index for applying forcing.
C jMin,jMax :: Working range of y-index for applying forcing.
C k :: Current vertical level index
C bi,bj :: Current tile indices
C myTime :: Current time in simulation
C myIter :: Current iteration number
C myThid :: my Thread Id number
_RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER k, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
CEOP
#ifdef ALLOW_AIM
C == Local variables ==
C i,j :: Loop counters
INTEGER I, J
C-- Forcing: add AIM heating/cooling tendency to gT:
DO J=1,sNy
DO I=1,sNx
gT_arr(i,j) = maskC(i,j,k,bi,bj)
& *( gT_arr(i,j) + aim_dTdt(i,j,k,bi,bj) )
ENDDO
ENDDO
#endif /* ALLOW_AIM */
RETURN
END
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C !ROUTINE: AIM_TENDENCY_APPLY_S
C !INTERFACE:
SUBROUTINE AIM_TENDENCY_APPLY_S(
U gS_arr,
I iMin,iMax,jMin,jMax, k, bi, bj,
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *==========================================================*
C | S/R AIM_TENDENCY_APPLY_S
C | o Add AIM tendency to Specific Humidity tendency.
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
c#include "DYNVARS.h"
#include "AIM2DYN.h"
C !INPUT/OUTPUT PARAMETERS:
C gS_arr :: the tendency array
C iMin,iMax :: Working range of x-index for applying forcing.
C jMin,jMax :: Working range of y-index for applying forcing.
C k :: Current vertical level index
C bi,bj :: Current tile indices
C myTime :: Current time in simulation
C myIter :: Current iteration number
C myThid :: my Thread Id number
_RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER k, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
CEOP
#ifdef ALLOW_AIM
C == Local variables ==
C i,j :: Loop counters
INTEGER I, J
C-- Forcing: add AIM dq/dt tendency to gS:
DO J=1,sNy
DO I=1,sNx
gS_arr(i,j) = maskC(i,j,k,bi,bj)
& *( gS_arr(i,j) + aim_dSdt(i,j,k,bi,bj) )
ENDDO
ENDDO
#endif /* ALLOW_AIM */
RETURN
END