C $Header: /u/gcmpack/MITgcm/model/src/calc_3d_diffusivity.F,v 1.16 2010/03/16 00:08:27 jmc Exp $
C $Name: $
#include "PACKAGES_CONFIG.h"
#include "CPP_OPTIONS.h"
CBOP
C !ROUTINE: CALC_3D_DIFFUSIVITY
C !INTERFACE:
SUBROUTINE CALC_3D_DIFFUSIVITY(
I bi,bj,iMin,iMax,jMin,jMax,
I trIdentity, trUseGMRedi, trUseKPP,
O KappaRTr,
I myThid)
C !DESCRIPTION: \bv
C *==========================================================*
C | SUBROUTINE CALC_3D_DIFFUSIVITY
C | o Calculate net (3D) vertical diffusivity for 1 tracer
C *==========================================================*
C | Combines spatially varying diffusion coefficients from
C | KPP and/or GM and/or convective stability test.
C *==========================================================*
C \ev
C !USES:
IMPLICIT NONE
C == GLobal variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.h"
#include "GRID.h"
#ifdef ALLOW_GENERIC_ADVDIFF
#include "GAD.h"
#endif
#ifdef ALLOW_PTRACERS
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#endif
#ifdef ALLOW_LONGSTEP
#include "LONGSTEP.h"
#endif
C !INPUT/OUTPUT PARAMETERS:
C == Routine arguments ==
C bi, bj :: tile indices
C iMin,iMax :: Range of points for which calculation is performed.
C jMin,jMax :: Range of points for which calculation is performed.
C trIdentity :: tracer identifier
C trUseGMRedi:: this tracer use GM-Redi
C trUseKPP :: this tracer use KPP
C myThid :: Instance number for this innvocation of CALC_3D_DIFFUSIVITY
C KappaRTr :: Net diffusivity for this tracer (trIdentity)
INTEGER bi,bj,iMin,iMax,jMin,jMax
INTEGER trIdentity
LOGICAL trUseGMRedi, trUseKPP
_RL KappaRTr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
INTEGER myThid
#ifdef ALLOW_GENERIC_ADVDIFF
C !LOCAL VARIABLES:
C == Local variables ==
C i, j, k :: Loop counters
C iTr :: passive tracer index
C msgBuf :: message buffer
INTEGER i,j,k
_RL KbryanLewis79
#ifdef ALLOW_BL79_LAT_VARY
_RL KbryanLewisEQ
#endif
CHARACTER*(MAX_LEN_MBUF) msgBuf
#ifdef ALLOW_PTRACERS
INTEGER iTr
#endif
CEOP
IF ( .NOT. trUseKPP ) THEN
DO k = 1,Nr
KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
& *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
#ifdef ALLOW_BL79_LAT_VARY
KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
& *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
#endif
DO j = 1-Oly,sNy+Oly
DO i = 1-Olx,sNx+Olx
#ifdef ALLOW_LONGSTEP
IF ( trIdentity .GE. GAD_TR1) THEN
KappaRTr(i,j,k) =
& LS_IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
& + KbryanLewis79
#ifdef ALLOW_BL79_LAT_VARY
& + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
#endif
ELSE
#else
IF ( .TRUE. ) THEN
#endif /* ALLOW_LONGSTEP */
KappaRTr(i,j,k) =
& IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
& + KbryanLewis79
#ifdef ALLOW_BL79_LAT_VARY
& + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
#endif
ENDIF
ENDDO
ENDDO
ENDDO
IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
DO k = 1,Nr
DO j = 1-Oly,sNy+Oly
DO i = 1-Olx,sNx+Olx
KappaRTr(i,j,k) = KappaRTr(i,j,k)
#if (defined ALLOW_3D_DIFFKR
(defined (ALLOW_AUTODIFF_TAMC) defined (ALLOW_DIFFKR_CONTROL)))
& + diffKr(i,j,k,bi,bj)
#else
& + diffKrNrT(k)
#endif
ENDDO
ENDDO
ENDDO
ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
DO k = 1,Nr
DO j = 1-Oly, sNy+Oly
DO i = 1-Olx, sNx+Olx
KappaRTr(i,j,k) = KappaRTr(i,j,k)
#if (defined ALLOW_3D_DIFFKR
(defined (ALLOW_AUTODIFF_TAMC) defined (ALLOW_DIFFKR_CONTROL)))
& + diffKr(i,j,k,bi,bj)
#else
& + diffKrNrS(k)
#endif
ENDDO
ENDDO
ENDDO
#ifdef ALLOW_PTRACERS
ELSEIF ( trIdentity.GE.GAD_TR1) THEN
iTr = trIdentity - GAD_TR1 + 1
DO k = 1,Nr
DO j = 1-Oly, sNy+Oly
DO i = 1-Olx, sNx+Olx
KappaRTr(i,j,k) = KappaRTr(i,j,k)
#if (defined ALLOW_3D_DIFFKR
(defined (ALLOW_AUTODIFF_TAMC) defined (ALLOW_DIFFKR_CONTROL)))
& + diffKr(i,j,k,bi,bj)
#else
& + PTRACERS_diffKrNr(k,iTr)
#endif
ENDDO
ENDDO
ENDDO
#endif /* ALLOW_PTRACERS */
ELSE
WRITE(msgBuf,'(A,I4)')
& ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
CALL PRINT_ERROR(msgBuf, myThid)
STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
ENDIF
ENDIF
C-- Add physical pacakge contributions:
#ifdef ALLOW_KPP
IF (trUseKPP) THEN
C-- Set vertical diffusivity contribution from KPP
IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
CALL KPP_CALC_DIFF_T(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
O KappaRTr,
I myThid)
ELSEIF (trIdentity.EQ.GAD_SALINITY) THEN
CALL KPP_CALC_DIFF_S(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
O KappaRTr,
I myThid)
ELSEIF ( trIdentity.GE.GAD_TR1) THEN
CALL KPP_CALC_DIFF_PTR(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
O KappaRTr,
I myThid)
ENDIF
#if (defined ALLOW_PTRACERS ! (defined ALLOW_3D_DIFFKR || \
(defined (ALLOW_AUTODIFF_TAMC) defined (ALLOW_DIFFKR_CONTROL))))
IF ( trIdentity.GE.GAD_TR1) THEN
iTr = trIdentity - GAD_TR1 + 1
DO k = 1,Nr
DO j = 1-Oly, sNy+Oly
DO i = 1-Olx, sNx+Olx
KappaRTr(i,j,k) = KappaRTr(i,j,k)
& - diffKrNrS(k) + PTRACERS_diffKrNr(k,iTr)
ENDDO
ENDDO
ENDDO
ENDIF
#endif
ENDIF
#endif /* ALLOW_KPP */
#ifdef ALLOW_GMREDI
IF (trUseGMRedi) THEN
CALL GMREDI_CALC_DIFF(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
U KappaRTr,
I trIdentity,myThid)
ENDIF
#endif
#ifdef ALLOW_PP81
IF (usePP81) THEN
CALL PP81_CALC_DIFF(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
U KappaRTr,
I myThid)
ENDIF
#endif
#ifdef ALLOW_MY82
IF (useMY82) THEN
CALL MY82_CALC_DIFF(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
U KappaRTr,
I myThid)
ENDIF
#endif
#ifdef ALLOW_GGL90
IF (useGGL90) THEN
CALL GGL90_CALC_DIFF(
I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
O KappaRTr,
I myThid)
ENDIF
#endif
C- Apply mask to vertical diffusivity
C jmc: do not have the impression that masking is needed
C but could be removed later if it is the case.
c DO j = 1-Oly, sNy+Oly
c DO i = 1-Olx, sNx+Olx
c KappaRTr(i,j,k) = maskUp(i,j)*KappaRTr(i,j,k)
c ENDDO
c ENDDO
#endif /* ALLOW_GENERIC_ADVDIFF */
RETURN
END