C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_tendency_apply.F,v 1.14 2014/07/16 20:12:21 jmc Exp $
C $Name: $
#include "FIZHI_OPTIONS.h"
SUBROUTINE FIZHI_TENDENCY_APPLY_U(
U gU_arr,
I iMin,iMax,jMin,jMax, kLev, bi, bj,
I myTime, myIter, myThid )
C=======================================================================
C Routine: fizhi_tendency_apply_u
C Interpolate tendencies from physics grid to dynamics grid and
C add fizhi tendency terms to U tendency.
C
C INPUT:
C iMin - Working range of tile for applying forcing.
C iMax
C jMin
C jMax
C kLev
C
C Notes: Routine works for one level at a time
C Assumes that U and V tendencies are already on C-Grid
C=======================================================================
IMPLICIT NONE
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "DYNVARS.h"
#include "fizhi_SIZE.h"
#include "fizhi_land_SIZE.h"
#include "fizhi_coms.h"
_RL gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER kLev, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
_RL rayleighdrag
_RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER i, j
#ifdef ALLOW_DIAGNOSTICS
LOGICAL DIAGNOSTICS_IS_ON
EXTERNAL
#endif
IF ( klev.EQ.Nr .OR. rC(klev).LT.1000. ) THEN
rayleighdrag = 1./(31.*86400.*2.)
ELSE
rayleighdrag = 0.
ENDIF
DO j=jMin,jMax
DO i=iMin,iMax
gU_arr(i,j) = gU_arr(i,j)
& + maskW(i,j,kLev,bi,bj)
& *( guphy(i,j,kLev,bi,bj)
& - rayleighdrag*uVel(i,j,kLev,bi,bj) )
ENDDO
ENDDO
IF ( DIAGNOSTICS_IS_ON('DIABUDYN',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) = maskW(i,j,kLev,bi,bj)
& *( guphy(i,j,kLev,bi,bj)
& - rayleighdrag*uVel(i,j,kLev,bi,bj) )
& * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'DIABUDYN',kLev,1,2,bi,bj,myThid)
ENDIF
IF ( DIAGNOSTICS_IS_ON('RFU ',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) = -1. _d 0 * rayleighdrag *
& maskW(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj) * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'RFU ',kLev,1,2,bi,bj,myThid)
ENDIF
RETURN
END
SUBROUTINE FIZHI_TENDENCY_APPLY_V(
U gV_arr,
I iMin,iMax,jMin,jMax, kLev, bi, bj,
I myTime, myIter, myThid )
C=======================================================================
C Routine: fizhi_tendency_apply_v
C Interpolate tendencies from physics grid to dynamics grid and
C add fizhi tendency terms to V tendency.
C
C INPUT:
C iMin - Working range of tile for applying forcing.
C iMax
C jMin
C jMax
C kLev
C
C Notes: Routine works for one level at a time
C Assumes that U and V tendencies are already on C-Grid
C=======================================================================
IMPLICIT NONE
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "DYNVARS.h"
#include "fizhi_SIZE.h"
#include "fizhi_land_SIZE.h"
#include "fizhi_coms.h"
_RL gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER kLev, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
_RL rayleighdrag
_RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER i, j
#ifdef ALLOW_DIAGNOSTICS
LOGICAL DIAGNOSTICS_IS_ON
EXTERNAL
#endif
IF ( klev.EQ.Nr .OR. rC(klev).LT.1000. ) THEN
rayleighdrag = 1./(31.*86400.*2.)
ELSE
rayleighdrag = 0.
ENDIF
DO j=jMin,jMax
DO i=iMin,iMax
gV_arr(i,j) = gV_arr(i,j)
& + maskS(i,j,kLev,bi,bj)
& *( gvphy(i,j,kLev,bi,bj)
& - rayleighdrag*vVel(i,j,kLev,bi,bj) )
ENDDO
ENDDO
IF ( DIAGNOSTICS_IS_ON('DIABVDYN',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) = maskS(i,j,kLev,bi,bj)
& *( gvphy(i,j,kLev,bi,bj)
& - rayleighdrag*vVel(i,j,kLev,bi,bj) )
& * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'DIABVDYN',kLev,1,2,bi,bj,myThid)
ENDIF
IF ( DIAGNOSTICS_IS_ON('RFV ',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) = -1. _d 0 * rayleighdrag *
& maskS(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj) * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'RFV ',kLev,1,2,bi,bj,myThid)
ENDIF
RETURN
END
SUBROUTINE FIZHI_TENDENCY_APPLY_T(
U gT_arr,
I iMin,iMax,jMin,jMax, kLev, bi, bj,
I myTime, myIter, myThid )
C=======================================================================
C Routine: fizhi_tendency_apply_t
C Interpolate tendencies from physics grid to dynamics grid and
C add fizhi tendency terms to T (theta) tendency.
C
C INPUT:
C iMin - Working range of tile for applying forcing.
C iMax
C jMin
C jMax
C kLev
C
C Notes: Routine works for one level at a time
C=======================================================================
IMPLICIT NONE
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "DYNVARS.h"
#include "fizhi_SIZE.h"
#include "fizhi_land_SIZE.h"
#include "fizhi_coms.h"
_RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER kLev, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
_RL rayleighdrag,getcon,cp,kappa,pNrkappa
_RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER i, j
#ifdef ALLOW_DIAGNOSTICS
LOGICAL DIAGNOSTICS_IS_ON
EXTERNAL
#endif
IF ( klev.EQ.Nr .OR. rC(klev).LT.1000. ) THEN
cp = getcon('CP')
kappa = getcon('KAPPA')
pNrkappa = (rC(klev)/100000.)**kappa
rayleighdrag = 1./((31.*86400.*2.)*(pNrkappa*cp))
ELSE
rayleighdrag = 0.
ENDIF
DO j=jMin,jMax
DO i=iMin,iMax
gT_arr(i,j) = gT_arr(i,j)
& + ( maskC(i,j,kLev,bi,bj)*gthphy(i,j,kLev,bi,bj)
& + rayleighdrag * 0.5
& *( maskW(i,j,kLev,bi,bj)
& *uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)
& + maskW(i+1,j,kLev,bi,bj)
& *uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)
& + maskS(i,j,kLev,bi,bj)
& *vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)
& + maskS(i,j+1,kLev,bi,bj)
& *vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)
& ) )
ENDDO
ENDDO
IF ( DIAGNOSTICS_IS_ON('DIABTDYN',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) =
& ( maskC(i,j,kLev,bi,bj)*gthphy(i,j,kLev,bi,bj)
& + rayleighdrag * 0.5
& *( maskW(i,j,kLev,bi,bj)
& *uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)
& + maskW(i+1,j,kLev,bi,bj)
& *uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)
& + maskS(i,j,kLev,bi,bj)
& *vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)
& + maskS(i,j+1,kLev,bi,bj)
& *vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)
& ) ) * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'DIABTDYN',kLev,1,2,bi,bj,myThid)
ENDIF
IF ( DIAGNOSTICS_IS_ON('RFT ',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) = ( rayleighdrag * 0.5
& *( maskW(i,j,kLev,bi,bj)
& *uVel(i,j,kLev,bi,bj)*uVel(i,j,kLev,bi,bj)
& + maskW(i+1,j,kLev,bi,bj)
& *uVel(i+1,j,kLev,bi,bj)*uVel(i+1,j,kLev,bi,bj)
& + maskS(i,j,kLev,bi,bj)
& *vVel(i,j,kLev,bi,bj)*vVel(i,j,kLev,bi,bj)
& + maskS(i,j+1,kLev,bi,bj)
& *vVel(i,j+1,kLev,bi,bj)*vVel(i,j+1,kLev,bi,bj)
& ) ) * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'RFT ',kLev,1,2,bi,bj,myThid)
ENDIF
RETURN
END
SUBROUTINE FIZHI_TENDENCY_APPLY_S(
U gS_arr,
I iMin,iMax,jMin,jMax, kLev, bi, bj,
I myTime, myIter, myThid )
C=======================================================================
C Routine: fizhi_tendency_apply_s
C Interpolate tendencies from physics grid to dynamics grid and
C add fizhi tendency terms to S tendency.
C
C INPUT:
C iMin - Working range of tile for applying forcing.
C iMax
C jMin
C jMax
C kLev
C
C Notes: Routine works for one level at a time
C=======================================================================
IMPLICIT NONE
#include "SIZE.h"
#include "GRID.h"
#include "EEPARAMS.h"
#include "DYNVARS.h"
#include "fizhi_SIZE.h"
#include "fizhi_land_SIZE.h"
#include "fizhi_coms.h"
_RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER iMin, iMax, jMin, jMax
INTEGER kLev, bi, bj
_RL myTime
INTEGER myIter
INTEGER myThid
_RL tmpdiag(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
INTEGER i, j
#ifdef ALLOW_DIAGNOSTICS
LOGICAL DIAGNOSTICS_IS_ON
EXTERNAL
#endif
DO j=jMin,jMax
DO i=iMin,iMax
gS_arr(i,j) = gS_arr(i,j)
& + maskC(i,j,kLev,bi,bj)*gsphy(i,j,kLev,bi,bj)
ENDDO
ENDDO
IF ( DIAGNOSTICS_IS_ON('DIABQDYN',myThid) ) THEN
DO j=jMin,jMax
DO i=iMin,iMax
tmpdiag(i,j) = ( maskC(i,j,kLev,bi,bj) * gsphy(i,j,kLev,bi,bj) )
& * 86400
ENDDO
ENDDO
CALL DIAGNOSTICS_FILL(tmpdiag,'DIABQDYN',kLev,1,2,bi,bj,myThid)
ENDIF
RETURN
END