/[MITgcm]/MITgcm/model/src/calc_diffusivity.F
ViewVC logotype

Diff of /MITgcm/model/src/calc_diffusivity.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.4 by adcroft, Wed Jun 10 16:05:39 1998 UTC revision 1.33 by jmc, Tue Sep 4 16:49:44 2007 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_EEOPTIONS.h"  #include "PACKAGES_CONFIG.h"
5    #include "CPP_OPTIONS.h"
6    
7  CStartOfInterFace  CBOP
8        SUBROUTINE CALC_DIFFUSIVITY(  C     !ROUTINE: CALC_DIFFUSIVITY
9       I        bi,bj,iMin,iMax,jMin,jMax,K,  C     !INTERFACE:
10       I        maskC,maskUp,KapGM,K33,        SUBROUTINE CALC_DIFFUSIVITY(
11       O        KappaZT,KappaZS,       I        bi,bj,iMin,iMax,jMin,jMax,k,
12         I        maskUp,
13         O        KappaRT,KappaRS,
14       I        myThid)       I        myThid)
15    
16  C     /==========================================================\  C     !DESCRIPTION: \bv
17  C     | SUBROUTINE CALC_DIFFUSIVITY                              |  C     *==========================================================*
18  C     | o Calculate net diffusivity                              |  C     | SUBROUTINE CALC_DIFFUSIVITY
19  C     |==========================================================|  C     | o Calculate net vertical diffusivity
20  C     \==========================================================/  C     *==========================================================*
21        IMPLICIT NONE  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 ==  C     == GLobal variables ==
29  #include "SIZE.h"  #include "SIZE.h"
30  #include "EEPARAMS.h"  #include "EEPARAMS.h"
31  #include "PARAMS.h"  #include "PARAMS.h"
32  #include "DYNVARS.h"  #include "DYNVARS.h"
33    #include "GRID.h"
34    
35    C     !INPUT/OUTPUT PARAMETERS:
36  C     == Routine arguments ==  C     == Routine arguments ==
37  C     bi, bj, iMin, iMax, jMin, jMax - Range of points for which calculation  C     bi, bj, :: tile indices
38  C     maskC   - land/water mask for tracer points  C     iMin,   :: Range of points for which calculation is performed.
39  C     maskUp  - land/water mask for Wvel points (above tracer level)  C     iMax,
40  C     myThid - Instance number for this innvocation of CALC_COMMON_FACTORS  C     jMin,
41  C  C     jMax
42    C     maskUp  :: land/water mask for Wvel points (above tracer level)
43    C     myThid  :: Instance number for this innvocation of CALC_DIFFUSIVITY
44    C     KappaRT :: Net diffusivity for temperature
45    C     KappaRS :: Net diffusivity for salinity
46        INTEGER bi,bj,iMin,iMax,jMin,jMax,K        INTEGER bi,bj,iMin,iMax,jMin,jMax,K
       _RS maskC(1-Olx:sNx+Olx,1-Oly:sNy+Oly)  
47        _RS maskUp(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RS maskUp(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
48        _RL KapGM(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL KappaRT(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL K33(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nz)        _RL KappaRS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
       _RL KappaZT(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nz)  
       _RL KappaZS(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nz)  
50        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
51    
52    C     !LOCAL VARIABLES:
53  C     == Local variables ==  C     == Local variables ==
54  C     I, J, K - Loop counters  C     I, J :: Loop counters
55        INTEGER i,j        INTEGER i,j
56          _RL KbryanLewis79
57    #ifdef ALLOW_BL79_LAT_VARY
58          _RL KbryanLewisEQ
59    #endif
60    CEOP
61    
62          IF ( .NOT. UseKPP ) THEN
63           KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
64         &      *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
65    #ifdef ALLOW_BL79_LAT_VARY
66           KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
67         &      *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
68    #endif
69    
70           DO j = 1-Oly, sNy+Oly
71            DO i = 1-Olx, sNx+Olx
72             KappaRT(i,j) =
73         &        IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
74    #if (defined ALLOW_3D_DIFFKR || \
75         (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
76         &        + diffKr(i,j,k,bi,bj)
77    #else
78         &        + diffKrNrT(k)
79    #endif
80         &        + KbryanLewis79
81    #ifdef ALLOW_BL79_LAT_VARY
82         &        + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
83    #endif
84            ENDDO
85           ENDDO
86    
87        DO j=jMin,jMax         DO j = 1-Oly, sNy+Oly
88         DO i=iMin,iMax          DO i = 1-Olx, sNx+Olx
89          KappaZT(i,j,k) = maskC(i,j)*maskUp(i,j)*           KappaRS(i,j) =
90       &      ( diffKzT + KapGM(i,j)*K33(i,j,k) )       &        IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
91    #if (defined ALLOW_3D_DIFFKR || \
92         (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
93         &        + diffKr(i,j,k,bi,bj)
94    #else
95         &        + diffKrNrS(k)
96    #endif
97         &        + KbryanLewis79
98    #ifdef ALLOW_BL79_LAT_VARY
99         &        + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
100    #endif
101            ENDDO
102         ENDDO         ENDDO
103        ENDDO        ENDIF
104    
105    #ifdef ALLOW_GMREDI
106          IF (useGMRedi) THEN
107             CALL GMREDI_CALC_DIFF(
108         I        bi,bj,iMin,iMax,jMin,jMax,k,1,
109         U        KappaRT,
110         I        myThid)
111             CALL GMREDI_CALC_DIFF(
112         I        bi,bj,iMin,iMax,jMin,jMax,k,1,
113         U        KappaRS,
114         I        myThid)
115          ENDIF
116    #endif
117    
118    #ifdef ALLOW_KPP
119          IF (useKPP) THEN
120             CALL KPP_CALC_DIFF_T(
121         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
122         U        KappaRT,
123         I        myThid)
124             CALL KPP_CALC_DIFF_S(
125         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
126         U        KappaRS,
127         I        myThid)
128          ENDIF
129    #endif
130    
131    #ifdef ALLOW_PP81
132          IF (usePP81) THEN
133             CALL PP81_CALC_DIFF(
134         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
135         U        KappaRT,
136         I        myThid)
137             CALL PP81_CALC_DIFF(
138         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
139         U        KappaRS,
140         I        myThid)
141          ENDIF
142    #endif
143    
144    #ifdef ALLOW_MY82
145          IF (useMY82) THEN
146             CALL MY82_CALC_DIFF(
147         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
148         U        KappaRT,
149         I        myThid)
150             CALL MY82_CALC_DIFF(
151         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
152         U        KappaRS,
153         I        myThid)
154          ENDIF
155    #endif
156    
157    #ifdef ALLOW_GGL90
158          IF (useGGL90) THEN
159             CALL GGL90_CALC_DIFF(
160         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
161         O        KappaRT,
162         I        myThid)
163             CALL GGL90_CALC_DIFF(
164         I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
165         O        KappaRS,
166         I        myThid)
167          ENDIF
168    #endif
169    
170        DO j=jMin,jMax  C-    Apply mask to vertical diffusivity
171         DO i=iMin,iMax  C jmc: don't have the impression that masking is needed
172          KappaZS(i,j,k) = maskC(i,j)*maskUp(i,j)*  C      but could be removed later if it's the case.
173       &      ( diffKzS + KapGM(i,j)*K33(i,j,k) )        DO j = 1-Oly, sNy+Oly
174           DO i = 1-Olx, sNx+Olx
175            KappaRT(i,j) = maskUp(i,j)*KappaRT(i,j)
176            KappaRS(i,j) = maskUp(i,j)*KappaRS(i,j)
177         ENDDO         ENDDO
178        ENDDO        ENDDO
179    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.33
  ViewVC Help
Powered by ViewVC 1.1.22