/[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.18 by edhill, Thu Oct 9 04:19:18 2003 UTC revision 1.33 by jmc, Tue Sep 4 16:49:44 2007 UTC
# Line 6  C $Name$ Line 6  C $Name$
6    
7  CBOP  CBOP
8  C     !ROUTINE: CALC_DIFFUSIVITY  C     !ROUTINE: CALC_DIFFUSIVITY
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE CALC_DIFFUSIVITY(        SUBROUTINE CALC_DIFFUSIVITY(
11       I        bi,bj,iMin,iMax,jMin,jMax,K,       I        bi,bj,iMin,iMax,jMin,jMax,k,
12       I        maskUp,       I        maskUp,
13       O        KappaRT,KappaRS,       O        KappaRT,KappaRS,
14       I        myThid)       I        myThid)
15    
16  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
17  C     *==========================================================*  C     *==========================================================*
18  C     | SUBROUTINE CALC_DIFFUSIVITY                                C     | SUBROUTINE CALC_DIFFUSIVITY
19  C     | o Calculate net vertical diffusivity                                C     | o Calculate net vertical diffusivity
20  C     *==========================================================*  C     *==========================================================*
21  C     | Combines spatially varying diffusion coefficients from  C     | Combines spatially varying diffusion coefficients from
22  C     | KPP and/or GM and/or convective stability test.  C     | KPP and/or GM and/or convective stability test.
# Line 34  C     == GLobal variables == Line 34  C     == GLobal variables ==
34    
35  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
36  C     == Routine arguments ==  C     == Routine arguments ==
37  C     bi, bj, :: Range of points for which calculation  C     bi, bj, :: tile indices
38  C     iMin,      is performed.  C     iMin,   :: Range of points for which calculation is performed.
39  C     iMax,  C     iMax,
40  C     jMin,  C     jMin,
41  C     jMax  C     jMax
42  C     maskUp  :: land/water mask for Wvel points (above tracer level)  C     maskUp  :: land/water mask for Wvel points (above tracer level)
43  C     myThid  :: Instance number for this innvocation of CALC_DIFFUSIVITY  C     myThid  :: Instance number for this innvocation of CALC_DIFFUSIVITY
# Line 45  C     KappaRT :: Net diffusivity for tem Line 45  C     KappaRT :: Net diffusivity for tem
45  C     KappaRS :: Net diffusivity for salinity  C     KappaRS :: Net diffusivity for salinity
46        INTEGER bi,bj,iMin,iMax,jMin,jMax,K        INTEGER bi,bj,iMin,iMax,jMin,jMax,K
47        _RS maskUp(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RS maskUp(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
48        _RL KappaRT(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRT(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL KappaRS(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
50        INTEGER myThid        INTEGER myThid
51    
52  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
53  C     == Local variables ==  C     == Local variables ==
54  C     I, J :: 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  CEOP
61    
62        DO j = 1-Oly, sNy+Oly        IF ( .NOT. UseKPP ) THEN
63         DO i = 1-Olx, sNx+Olx         KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
64          KappaRT(i,j,k) = maskUp(i,j)*       &      *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
65       &      (  #ifdef ALLOW_BL79_LAT_VARY
66       &         KappaRT(i,j,k)         KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
67  #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL))       &      *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
68       &       + diffKr(i,j,k,bi,bj)  #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  #else
78       &       + diffKrT       &        + diffKrNrT(k)
79  #endif  #endif
80       &      )       &        + KbryanLewis79
81    #ifdef ALLOW_BL79_LAT_VARY
82         &        + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
83    #endif
84            ENDDO
85         ENDDO         ENDDO
       ENDDO  
86    
87        DO j = 1-Oly, sNy+Oly         DO j = 1-Oly, sNy+Oly
88         DO i = 1-Olx, sNx+Olx          DO i = 1-Olx, sNx+Olx
89          KappaRS(i,j,k) = maskUp(i,j)*           KappaRS(i,j) =
90       &      (       &        IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
91       &         KappaRS(i,j,k)  #if (defined ALLOW_3D_DIFFKR || \
92  #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL))       (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
93       &       + diffKr(i,j,k,bi,bj)       &        + diffKr(i,j,k,bi,bj)
94  #else  #else
95       &       + diffKrS       &        + diffKrNrS(k)
96  #endif  #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  #ifdef ALLOW_GMREDI
106        IF (useGMRedi) CALL GMREDI_CALC_DIFF(        IF (useGMRedi) THEN
107       I        bi,bj,iMin,iMax,jMin,jMax,K,           CALL GMREDI_CALC_DIFF(
108       I        maskUp,       I        bi,bj,iMin,iMax,jMin,jMax,k,1,
109       O        KappaRT,KappaRS,       U        KappaRT,
110       I        myThid)       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  #endif
117    
118  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
119        IF (useKPP) CALL KPP_CALC_DIFF(        IF (useKPP) THEN
120       I        bi,bj,iMin+1,iMax,jMin+1,jMax,K,           CALL KPP_CALC_DIFF_T(
121       I        maskUp,       I        bi,bj,iMin+1,iMax,jMin+1,jMax,k,1,
122       O        KappaRT,KappaRS,       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)       I        myThid)
128          ENDIF
129  #endif  #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    C-    Apply mask to vertical diffusivity
171    C jmc: don't have the impression that masking is needed
172    C      but could be removed later if it's the case.
173          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
178          ENDDO
179    
180        RETURN        RETURN
181        END        END
Legend:
Removed from v.1.18  
changed lines
  Added in v.1.33
  ViewVC Help
Powered by ViewVC 1.1.22