model/src/calc_3d_diffusivity.F

C $Header: /u/gcmpack/MITgcm/model/src/calc_3d_diffusivity.F,v 1.5 2007/04/05 00:02:49 dimitri 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.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
      CHARACTER*(MAX_LEN_MBUF) msgBuf
#ifdef ALLOW_PTRACERS
      INTEGER iTr
#endif
CEOP

      IF ( trIdentity.EQ.GAD_TEMPERATURE) THEN

       DO k = 1,Nr
        KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
     &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)
        DO j = 1-Oly,sNy+Oly
         DO i = 1-Olx,sNx+Olx
          KappaRTr(i,j,k) =
     &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
#if (defined ALLOW_3D_DIFFKR || \
     (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
     &       + diffKr(i,j,k,bi,bj)
#else
     &       + diffKrNrT(k)
#endif
     &       + KbryanLewis79
         ENDDO
        ENDDO
       ENDDO

      ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN

       DO k = 1,Nr
        KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
     &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)
        DO j = 1-Oly, sNy+Oly
         DO i = 1-Olx, sNx+Olx
          KappaRTr(i,j,k) =
     &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
#if (defined ALLOW_3D_DIFFKR || \
     (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
     &       + diffKr(i,j,k,bi,bj)
#else
     &       + diffKrNrS(k)
#endif
     &       + KbryanLewis79
         ENDDO
        ENDDO
       ENDDO

#ifdef ALLOW_PTRACERS
      ELSEIF ( trIdentity.GE.GAD_TR1
     &   .AND. trIdentity.LT.GAD_TR1+PTRACERS_numInUse) THEN

       iTr = trIdentity - GAD_TR1 + 1
       DO k = 1,Nr
        KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
     &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)
        DO j = 1-Oly, sNy+Oly
         DO i = 1-Olx, sNx+Olx
          KappaRTr(i,j,k) =
     &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
#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
         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

C--   Add physical pacakge contributions:

#ifdef ALLOW_GMREDI
      IF (trUseGMRedi) THEN 
         CALL GMREDI_CALC_DIFF(
     I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
     U        KappaRTr,
     I        myThid)
      ENDIF
#endif

#ifdef ALLOW_KPP
      IF (trUseKPP) THEN
       IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
         CALL KPP_CALC_DIFF_T(
     I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
     U        KappaRTr,
     I        myThid)
       ELSE
         CALL KPP_CALC_DIFF_S(
     I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
     U        KappaRTr,
     I        myThid)
       ENDIF
      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: don't have the impression that masking is needed 
C      but could be removed later if it's 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	C $Header: /u/gcmpack/MITgcm/model/src/calc_3d_diffusivity.F,v 1.5 2007/04/05 00:02:49 dimitri Exp $
2	C $Name: $
3
4	#include "PACKAGES_CONFIG.h"
5	#include "CPP_OPTIONS.h"
6
7	CBOP
8	C !ROUTINE: CALC_3D_DIFFUSIVITY
9	C !INTERFACE:
10	SUBROUTINE CALC_3D_DIFFUSIVITY(
11	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	#ifdef ALLOW_GENERIC_ADVDIFF
35	#include "GAD.h"
36	#endif
37	#ifdef ALLOW_PTRACERS
38	#include "PTRACERS_SIZE.h"
39	#include "PTRACERS.h"
40	#endif
41
42	C !INPUT/OUTPUT PARAMETERS:
43	C == Routine arguments ==
44	C bi, bj :: tile indices
45	C iMin,iMax :: Range of points for which calculation is performed.
46	C jMin,jMax :: Range of points for which calculation is performed.
47	C trIdentity :: tracer identifier
48	C trUseGMRedi:: this tracer use GM-Redi
49	C trUseKPP :: this tracer use KPP
50	C myThid :: Instance number for this innvocation of CALC_3D_DIFFUSIVITY
51	C KappaRTr :: Net diffusivity for this tracer (trIdentity)
52	INTEGER bi,bj,iMin,iMax,jMin,jMax
53	INTEGER trIdentity
54	LOGICAL trUseGMRedi, trUseKPP
55	_RL KappaRTr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
56	INTEGER myThid
57
58	#ifdef ALLOW_GENERIC_ADVDIFF
59	C !LOCAL VARIABLES:
60	C == Local variables ==
61	C i, j, k :: Loop counters
62	C iTr :: passive tracer index
63	C msgBuf :: message buffer
64	INTEGER i,j,k
65	_RL KbryanLewis79
66	CHARACTER*(MAX_LEN_MBUF) msgBuf
67	#ifdef ALLOW_PTRACERS
68	INTEGER iTr
69	#endif
70	CEOP
71
72	IF ( trIdentity.EQ.GAD_TEMPERATURE) THEN
73
74	DO k = 1,Nr
75	KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
76	& *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)
77	DO j = 1-Oly,sNy+Oly
78	DO i = 1-Olx,sNx+Olx
79	KappaRTr(i,j,k) =
80	& IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
81	#if (defined ALLOW_3D_DIFFKR \|\| \
82	(defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
83	& + diffKr(i,j,k,bi,bj)
84	#else
85	& + diffKrNrT(k)
86	#endif
87	& + KbryanLewis79
88	ENDDO
89	ENDDO
90	ENDDO
91
92	ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
93
94	DO k = 1,Nr
95	KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
96	& *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)
97	DO j = 1-Oly, sNy+Oly
98	DO i = 1-Olx, sNx+Olx
99	KappaRTr(i,j,k) =
100	& IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
101	#if (defined ALLOW_3D_DIFFKR \|\| \
102	(defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
103	& + diffKr(i,j,k,bi,bj)
104	#else
105	& + diffKrNrS(k)
106	#endif
107	& + KbryanLewis79
108	ENDDO
109	ENDDO
110	ENDDO
111
112	#ifdef ALLOW_PTRACERS
113	ELSEIF ( trIdentity.GE.GAD_TR1
114	& .AND. trIdentity.LT.GAD_TR1+PTRACERS_numInUse) THEN
115
116	iTr = trIdentity - GAD_TR1 + 1
117	DO k = 1,Nr
118	KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
119	& *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)
120	DO j = 1-Oly, sNy+Oly
121	DO i = 1-Olx, sNx+Olx
122	KappaRTr(i,j,k) =
123	& IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
124	#if (defined ALLOW_3D_DIFFKR \|\| \
125	(defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
126	& + diffKr(i,j,k,bi,bj)
127	#else
128	& + PTRACERS_diffKrNr(k,iTr)
129	#endif
130	& + KbryanLewis79
131	ENDDO
132	ENDDO
133	ENDDO
134	#endif /* ALLOW_PTRACERS */
135
136	ELSE
137	WRITE(msgBuf,'(A,I4)')
138	& ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
139	CALL PRINT_ERROR(msgBuf, myThid)
140	STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
141	ENDIF
142
143	C-- Add physical pacakge contributions:
144
145	#ifdef ALLOW_GMREDI
146	IF (trUseGMRedi) THEN
147	CALL GMREDI_CALC_DIFF(
148	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
149	U KappaRTr,
150	I myThid)
151	ENDIF
152	#endif
153
154	#ifdef ALLOW_KPP
155	IF (trUseKPP) THEN
156	IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
157	CALL KPP_CALC_DIFF_T(
158	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
159	U KappaRTr,
160	I myThid)
161	ELSE
162	CALL KPP_CALC_DIFF_S(
163	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
164	U KappaRTr,
165	I myThid)
166	ENDIF
167	ENDIF
168	#endif
169
170	#ifdef ALLOW_PP81
171	IF (usePP81) THEN
172	CALL PP81_CALC_DIFF(
173	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
174	U KappaRTr,
175	I myThid)
176	ENDIF
177	#endif
178
179	#ifdef ALLOW_MY82
180	IF (useMY82) THEN
181	CALL MY82_CALC_DIFF(
182	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
183	U KappaRTr,
184	I myThid)
185	ENDIF
186	#endif
187
188	#ifdef ALLOW_GGL90
189	IF (useGGL90) THEN
190	CALL GGL90_CALC_DIFF(
191	I bi,bj,iMin,iMax,jMin,jMax,0,Nr,
192	O KappaRTr,
193	I myThid)
194	ENDIF
195	#endif
196
197	C- Apply mask to vertical diffusivity
198	C jmc: don't have the impression that masking is needed
199	C but could be removed later if it's the case.
200	c DO j = 1-Oly, sNy+Oly
201	c DO i = 1-Olx, sNx+Olx
202	c KappaRTr(i,j,k) = maskUp(i,j)*KappaRTr(i,j,k)
203	c ENDDO
204	c ENDDO
205
206	#endif /* ALLOW_GENERIC_ADVDIFF */
207
208	RETURN
209	END