pkg/ptracers/ptracers_calc_diff.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_calc_diff.F,v 1.7 2009/06/26 23:10:10 jahn Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

CBOP
C     !ROUTINE: PTRACERS_CALC_DIFF
C     !INTERFACE:
      SUBROUTINE PTRACERS_CALC_DIFF(
     I        bi,bj,iMin,iMax,jMin,jMax,k,
     I        maskUp,
     O        KappaRtr,
     I        myThid)

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE PTRACERS_CALC_DIFF
C     | o Calculate net vertical diffusivity for passive tracers
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 "GRID.h"
#include "DYNVARS.h"
#ifdef ALLOW_LONGSTEP
#include "LONGSTEP.h"
#endif
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
c #include "PTRACERS_FIELDS.h"
#include "GAD.h"

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     maskUp    :: land/water mask for Wvel points (above tracer level)
C     myThid    :: Instance number for this innvocation of PTRACERS_CALC_DIFF
C     KappaRtr  :: Net diffusivity for temperature
C     KappaRS   :: Net diffusivity for salinity
      INTEGER bi,bj,iMin,iMax,jMin,jMax,k
      _RS maskUp(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
      _RL KappaRtr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,PTRACERS_num)
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
C     I, J :: Loop counters
      INTEGER i,j,iTr,trIdentity
      _RL KbryanLewis79
#ifdef ALLOW_BL79_LAT_VARY
      _RL KbryanLewisEQ
#endif
CEOP

      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

C Loop over tracers
      DO iTr=1,PTRACERS_numInUse

       trIdentity = iTr + GAD_TR1 - 1

       IF ( .NOT. PTRACERS_useKPP(iTr) ) THEN
        DO j = 1-Oly, sNy+Oly
         DO i = 1-Olx, sNx+Olx
          KappaRtr(i,j,iTr) =
#ifdef ALLOW_LONGSTEP
     &         LS_IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
#else
     &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
#endif
#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
     &       + KbryanLewis79
#ifdef ALLOW_BL79_LAT_VARY
     &        + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
#endif
         ENDDO
        ENDDO
       ENDIF

#ifdef ALLOW_KPP
        IF ( PTRACERS_useKPP(iTr) ) THEN
C--   Set vertical diffusivity contribution from KPP
         CALL KPP_CALC_DIFF_PTR(
     I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
     O        KappaRtr(1-Olx,1-Oly,iTr),
     I        myThid)
        ENDIF
#endif

#ifdef ALLOW_GMREDI
        IF ( PTRACERS_useGMRedi(iTr) ) THEN
         CALL GMREDI_CALC_DIFF(
     I        bi,bj,iMin,iMax,jMin,jMax,k,1,
     U        KappaRtr(1-Olx,1-Oly,iTr),
     I        trIdentity,myThid)
        ENDIF
#endif

#ifdef ALLOW_PP81
        IF (usePP81) THEN
         CALL PP81_CALC_DIFF(
     I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
     U        KappaRtr(1-Olx,1-Oly,iTr),
     I        myThid)
        ENDIF
#endif

#ifdef ALLOW_MY82
        IF (useMY82) THEN
         CALL MY82_CALC_DIFF(
     I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
     U        KappaRtr(1-Olx,1-Oly,iTr),
     I        myThid)
        ENDIF
#endif

#ifdef ALLOW_GGL90
        IF (useGGL90) THEN
         CALL GGL90_CALC_DIFF(
     I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
     U        KappaRtr(1-Olx,1-Oly,iTr),
     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.
        DO j = 1-Oly, sNy+Oly
         DO i = 1-Olx, sNx+Olx
          KappaRtr(i,j,iTr) = maskUp(i,j)*KappaRtr(i,j,iTr)
         ENDDO
        ENDDO

C end of tracer loop
      ENDDO

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_calc_diff.F,v 1.7 2009/06/26 23:10:10 jahn Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PTRACERS_OPTIONS.h"
5
6			CBOP
7			C !ROUTINE: PTRACERS_CALC_DIFF
8	jmc	1.5	C !INTERFACE:
9			SUBROUTINE PTRACERS_CALC_DIFF(
10	jmc	1.1	I bi,bj,iMin,iMax,jMin,jMax,k,
11			I maskUp,
12			O KappaRtr,
13			I myThid)
14
15			C !DESCRIPTION: \bv
16			C ==========================================================
17			C \| SUBROUTINE PTRACERS_CALC_DIFF
18			C \| o Calculate net vertical diffusivity for passive tracers
19			C ==========================================================
20			C \| Combines spatially varying diffusion coefficients from
21			C \| KPP and/or GM and/or convective stability test.
22			C ==========================================================
23			C \ev
24
25			C !USES:
26			IMPLICIT NONE
27			C == GLobal variables ==
28			#include "SIZE.h"
29			#include "EEPARAMS.h"
30			#include "PARAMS.h"
31			#include "GRID.h"
32			#include "DYNVARS.h"
33	jahn	1.7	#ifdef ALLOW_LONGSTEP
34			#include "LONGSTEP.h"
35			#endif
36	jmc	1.1	#include "PTRACERS_SIZE.h"
37	jmc	1.5	#include "PTRACERS_PARAMS.h"
38			c #include "PTRACERS_FIELDS.h"
39	dfer	1.6	#include "GAD.h"
40	jmc	1.1
41			C !INPUT/OUTPUT PARAMETERS:
42			C == Routine arguments ==
43			C bi, bj :: tile indices
44			C iMin,iMax :: Range of points for which calculation is performed.
45			C jMin,jMax :: Range of points for which calculation is performed.
46			C maskUp :: land/water mask for Wvel points (above tracer level)
47			C myThid :: Instance number for this innvocation of PTRACERS_CALC_DIFF
48			C KappaRtr :: Net diffusivity for temperature
49			C KappaRS :: Net diffusivity for salinity
50			INTEGER bi,bj,iMin,iMax,jMin,jMax,k
51			_RS maskUp(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
52			_RL KappaRtr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,PTRACERS_num)
53			INTEGER myThid
54
55			C !LOCAL VARIABLES:
56			C == Local variables ==
57			C I, J :: Loop counters
58	dfer	1.6	INTEGER i,j,iTr,trIdentity
59	jmc	1.5	_RL KbryanLewis79
60			#ifdef ALLOW_BL79_LAT_VARY
61			_RL KbryanLewisEQ
62			#endif
63	jmc	1.1	CEOP
64
65			KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
66	dimitri	1.3	& *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
67			#ifdef ALLOW_BL79_LAT_VARY
68			KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
69			& *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
70			#endif
71	jmc	1.1
72			C Loop over tracers
73			DO iTr=1,PTRACERS_numInUse
74
75	dfer	1.6	trIdentity = iTr + GAD_TR1 - 1
76
77	dimitri	1.3	IF ( .NOT. PTRACERS_useKPP(iTr) ) THEN
78	jmc	1.1	DO j = 1-Oly, sNy+Oly
79			DO i = 1-Olx, sNx+Olx
80			KappaRtr(i,j,iTr) =
81	jahn	1.7	#ifdef ALLOW_LONGSTEP
82			& LS_IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
83			#else
84	jmc	1.1	& IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
85	jahn	1.7	#endif
86	dimitri	1.3	#if (defined ALLOW_3D_DIFFKR \|\| \
87			(defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
88	jmc	1.1	& + diffKr(i,j,k,bi,bj)
89			#else
90			& + PTRACERS_diffKrNr(k,iTr)
91			#endif
92			& + KbryanLewis79
93	dimitri	1.3	#ifdef ALLOW_BL79_LAT_VARY
94			& + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
95			#endif
96	jmc	1.1	ENDDO
97			ENDDO
98	dimitri	1.3	ENDIF
99	jmc	1.1
100	dimitri	1.4	#ifdef ALLOW_KPP
101			IF ( PTRACERS_useKPP(iTr) ) THEN
102			C-- Set vertical diffusivity contribution from KPP
103	jahn	1.7	CALL KPP_CALC_DIFF_PTR(
104	dimitri	1.4	I bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
105			O KappaRtr(1-Olx,1-Oly,iTr),
106			I myThid)
107			ENDIF
108			#endif
109
110	jmc	1.1	#ifdef ALLOW_GMREDI
111	jmc	1.5	IF ( PTRACERS_useGMRedi(iTr) ) THEN
112	jmc	1.1	CALL GMREDI_CALC_DIFF(
113			I bi,bj,iMin,iMax,jMin,jMax,k,1,
114			U KappaRtr(1-Olx,1-Oly,iTr),
115	dfer	1.6	I trIdentity,myThid)
116	jmc	1.1	ENDIF
117			#endif
118
119			#ifdef ALLOW_PP81
120			IF (usePP81) THEN
121			CALL PP81_CALC_DIFF(
122			I bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
123			U KappaRtr(1-Olx,1-Oly,iTr),
124			I myThid)
125			ENDIF
126			#endif
127
128			#ifdef ALLOW_MY82
129			IF (useMY82) THEN
130			CALL MY82_CALC_DIFF(
131			I bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
132			U KappaRtr(1-Olx,1-Oly,iTr),
133			I myThid)
134			ENDIF
135			#endif
136	jmc	1.5
137	jmc	1.1	#ifdef ALLOW_GGL90
138			IF (useGGL90) THEN
139			CALL GGL90_CALC_DIFF(
140			I bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
141			U KappaRtr(1-Olx,1-Oly,iTr),
142			I myThid)
143			ENDIF
144			#endif
145	jmc	1.5
146			C- Apply mask to vertical diffusivity
147	jmc	1.8	C jmc: do not have the impression that masking is needed
148			C but could be removed later if it is the case.
149	jmc	1.1	DO j = 1-Oly, sNy+Oly
150			DO i = 1-Olx, sNx+Olx
151			KappaRtr(i,j,iTr) = maskUp(i,j)*KappaRtr(i,j,iTr)
152			ENDDO
153			ENDDO
154
155			C end of tracer loop
156			ENDDO
157
158			RETURN
159			END