model/src/calc_3d_diffusivity.F

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)
#ifdef ALLOW_3D_DIFFKR
     &          + 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)
#ifdef ALLOW_3D_DIFFKR
     &          + 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)
#ifdef ALLOW_3D_DIFFKR
     &          + 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)
#ifdef ALLOW_PTRACERS
       ELSEIF ( trIdentity.GE.GAD_TR1) THEN
         iTr = trIdentity - GAD_TR1 + 1
         CALL KPP_CALC_DIFF_Ptr(
     I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
     O        KappaRTr,
     I        iTr, myThid )
#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
#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
1	jmc	1.17	C $Header: /u/gcmpack/MITgcm/model/src/calc_3d_diffusivity.F,v 1.16 2010/03/16 00:08:27 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PACKAGES_CONFIG.h"
5			#include "CPP_OPTIONS.h"
6
7			CBOP
8			C !ROUTINE: CALC_3D_DIFFUSIVITY
9	jmc	1.11	C !INTERFACE:
10			SUBROUTINE CALC_3D_DIFFUSIVITY(
11	jmc	1.1	I bi,bj,iMin,iMax,jMin,jMax,
12			I trIdentity, trUseGMRedi, trUseKPP,
13			O KappaRTr,
14			I myThid)
15
16			C !DESCRIPTION: \bv
17			C ==========================================================
18			C \| SUBROUTINE CALC_3D_DIFFUSIVITY
19			C \| o Calculate net (3D) vertical diffusivity for 1 tracer
20			C ==========================================================
21			C \| Combines spatially varying diffusion coefficients from
22			C \| KPP and/or GM and/or convective stability test.
23			C ==========================================================
24			C \ev
25
26			C !USES:
27			IMPLICIT NONE
28			C == GLobal variables ==
29			#include "SIZE.h"
30			#include "EEPARAMS.h"
31			#include "PARAMS.h"
32			#include "DYNVARS.h"
33			#include "GRID.h"
34	jmc	1.3	#ifdef ALLOW_GENERIC_ADVDIFF
35	jmc	1.1	#include "GAD.h"
36	jmc	1.3	#endif
37	jmc	1.1	#ifdef ALLOW_PTRACERS
38			#include "PTRACERS_SIZE.h"
39	jmc	1.13	#include "PTRACERS_PARAMS.h"
40	jmc	1.1	#endif
41	jahn	1.15	#ifdef ALLOW_LONGSTEP
42			#include "LONGSTEP.h"
43			#endif
44	jmc	1.1
45			C !INPUT/OUTPUT PARAMETERS:
46			C == Routine arguments ==
47			C bi, bj :: tile indices
48			C iMin,iMax :: Range of points for which calculation is performed.
49			C jMin,jMax :: Range of points for which calculation is performed.
50			C trIdentity :: tracer identifier
51			C trUseGMRedi:: this tracer use GM-Redi
52			C trUseKPP :: this tracer use KPP
53			C myThid :: Instance number for this innvocation of CALC_3D_DIFFUSIVITY
54			C KappaRTr :: Net diffusivity for this tracer (trIdentity)
55			INTEGER bi,bj,iMin,iMax,jMin,jMax
56			INTEGER trIdentity
57			LOGICAL trUseGMRedi, trUseKPP
58			_RL KappaRTr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
59			INTEGER myThid
60
61	jmc	1.3	#ifdef ALLOW_GENERIC_ADVDIFF
62	jmc	1.1	C !LOCAL VARIABLES:
63			C == Local variables ==
64			C i, j, k :: Loop counters
65			C iTr :: passive tracer index
66			C msgBuf :: message buffer
67			INTEGER i,j,k
68	jmc	1.11	_RL KbryanLewis79
69			#ifdef ALLOW_BL79_LAT_VARY
70			_RL KbryanLewisEQ
71			#endif
72	jmc	1.1	CHARACTER*(MAX_LEN_MBUF) msgBuf
73	jmc	1.4	#ifdef ALLOW_PTRACERS
74			INTEGER iTr
75			#endif
76	jmc	1.1	CEOP
77
78	dimitri	1.10	IF ( .NOT. trUseKPP ) THEN
79	jmc	1.1	DO k = 1,Nr
80	jmc	1.8	KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
81	dimitri	1.10	& *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
82	dimitri	1.9	#ifdef ALLOW_BL79_LAT_VARY
83			KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
84	dimitri	1.10	& *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
85	dimitri	1.9	#endif
86	jmc	1.1	DO j = 1-Oly,sNy+Oly
87			DO i = 1-Olx,sNx+Olx
88	jahn	1.15	#ifdef ALLOW_LONGSTEP
89			IF ( trIdentity .GE. GAD_TR1) THEN
90			KappaRTr(i,j,k) =
91			& LS_IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
92			& + KbryanLewis79
93			#ifdef ALLOW_BL79_LAT_VARY
94			& + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
95			#endif
96			ELSE
97			#else
98			IF ( .TRUE. ) THEN
99			#endif /* ALLOW_LONGSTEP */
100			KappaRTr(i,j,k) =
101	jmc	1.1	& IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
102	dimitri	1.10	& + KbryanLewis79
103			#ifdef ALLOW_BL79_LAT_VARY
104			& + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
105			#endif
106	jahn	1.15	ENDIF
107	dimitri	1.10	ENDDO
108			ENDDO
109			ENDDO
110			IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
111			DO k = 1,Nr
112			DO j = 1-Oly,sNy+Oly
113			DO i = 1-Olx,sNx+Olx
114	jmc	1.11	KappaRTr(i,j,k) = KappaRTr(i,j,k)
115	jmc	1.17	#ifdef ALLOW_3D_DIFFKR
116	dimitri	1.10	& + diffKr(i,j,k,bi,bj)
117	jmc	1.1	#else
118	dimitri	1.10	& + diffKrNrT(k)
119	dimitri	1.9	#endif
120	dimitri	1.10	ENDDO
121	jmc	1.1	ENDDO
122			ENDDO
123	dimitri	1.10	ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
124			DO k = 1,Nr
125			DO j = 1-Oly, sNy+Oly
126			DO i = 1-Olx, sNx+Olx
127			KappaRTr(i,j,k) = KappaRTr(i,j,k)
128	jmc	1.17	#ifdef ALLOW_3D_DIFFKR
129	dimitri	1.10	& + diffKr(i,j,k,bi,bj)
130	jmc	1.1	#else
131	dimitri	1.10	& + diffKrNrS(k)
132	dimitri	1.9	#endif
133	dimitri	1.10	ENDDO
134	jmc	1.1	ENDDO
135			ENDDO
136			#ifdef ALLOW_PTRACERS
137	jahn	1.15	ELSEIF ( trIdentity.GE.GAD_TR1) THEN
138	jmc	1.1
139	dimitri	1.10	iTr = trIdentity - GAD_TR1 + 1
140			DO k = 1,Nr
141			DO j = 1-Oly, sNy+Oly
142			DO i = 1-Olx, sNx+Olx
143			KappaRTr(i,j,k) = KappaRTr(i,j,k)
144	jmc	1.17	#ifdef ALLOW_3D_DIFFKR
145	dimitri	1.10	& + diffKr(i,j,k,bi,bj)
146	jmc	1.1	#else
147	dimitri	1.10	& + PTRACERS_diffKrNr(k,iTr)
148	dimitri	1.9	#endif
149	dimitri	1.10	ENDDO
150	jmc	1.1	ENDDO
151			ENDDO
152			#endif /* ALLOW_PTRACERS */
153	dimitri	1.10	ELSE
154	jmc	1.1	WRITE(msgBuf,'(A,I4)')
155	dimitri	1.10	& ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
156	jmc	1.1	CALL PRINT_ERROR(msgBuf, myThid)
157			STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
158	dimitri	1.10	ENDIF
159	jmc	1.1	ENDIF
160
161			C-- Add physical pacakge contributions:
162
163			#ifdef ALLOW_KPP
164			IF (trUseKPP) THEN
165	dimitri	1.12	C-- Set vertical diffusivity contribution from KPP
166	jmc	1.1	IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
167			CALL KPP_CALC_DIFF_T(
168	jmc	1.2	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
169	dimitri	1.12	O KappaRTr,
170	jmc	1.1	I myThid)
171	jahn	1.15	ELSEIF (trIdentity.EQ.GAD_SALINITY) THEN
172	jmc	1.1	CALL KPP_CALC_DIFF_S(
173	jmc	1.2	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
174	dimitri	1.12	O KappaRTr,
175	jmc	1.1	I myThid)
176	jmc	1.17	#ifdef ALLOW_PTRACERS
177	jahn	1.15	ELSEIF ( trIdentity.GE.GAD_TR1) THEN
178	jmc	1.17	iTr = trIdentity - GAD_TR1 + 1
179	jahn	1.15	CALL KPP_CALC_DIFF_Ptr(
180			I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
181			O KappaRTr,
182	jmc	1.17	I iTr, myThid )
183			#endif /* ALLOW_PTRACERS */
184			ELSE
185			WRITE(msgBuf,'(A,I4)')
186			& ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
187			CALL PRINT_ERROR( msgBuf, myThid )
188			STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
189	jmc	1.1	ENDIF
190	dimitri	1.10	ENDIF
191			#endif /* ALLOW_KPP */
192
193			#ifdef ALLOW_GMREDI
194	jmc	1.11	IF (trUseGMRedi) THEN
195	dimitri	1.10	CALL GMREDI_CALC_DIFF(
196			I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
197			U KappaRTr,
198	dfer	1.14	I trIdentity,myThid)
199	jmc	1.1	ENDIF
200			#endif
201
202			#ifdef ALLOW_PP81
203			IF (usePP81) THEN
204			CALL PP81_CALC_DIFF(
205	jmc	1.2	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
206	jmc	1.1	U KappaRTr,
207			I myThid)
208			ENDIF
209			#endif
210
211			#ifdef ALLOW_MY82
212			IF (useMY82) THEN
213			CALL MY82_CALC_DIFF(
214	jmc	1.2	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
215	jmc	1.1	U KappaRTr,
216			I myThid)
217			ENDIF
218			#endif
219	jmc	1.11
220	jmc	1.1	#ifdef ALLOW_GGL90
221			IF (useGGL90) THEN
222			CALL GGL90_CALC_DIFF(
223	jmc	1.2	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
224	jmc	1.1	O KappaRTr,
225			I myThid)
226			ENDIF
227			#endif
228	jmc	1.11
229			C- Apply mask to vertical diffusivity
230	jmc	1.16	C jmc: do not have the impression that masking is needed
231			C but could be removed later if it is the case.
232	jmc	1.1	c DO j = 1-Oly, sNy+Oly
233			c DO i = 1-Olx, sNx+Olx
234			c KappaRTr(i,j,k) = maskUp(i,j)*KappaRTr(i,j,k)
235			c ENDDO
236			c ENDDO
237
238	jmc	1.3	#endif /* ALLOW_GENERIC_ADVDIFF */
239
240	jmc	1.1	RETURN
241			END