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

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

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

revision 1.8 by jmc, Wed Apr 11 15:05:58 2007 UTC revision 1.17 by jmc, Tue Sep 20 22:25:23 2011 UTC
# Line 6  C $Name$ Line 6  C $Name$
6    
7  CBOP  CBOP
8  C     !ROUTINE: CALC_3D_DIFFUSIVITY  C     !ROUTINE: CALC_3D_DIFFUSIVITY
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE CALC_3D_DIFFUSIVITY(        SUBROUTINE CALC_3D_DIFFUSIVITY(
11       I        bi,bj,iMin,iMax,jMin,jMax,       I        bi,bj,iMin,iMax,jMin,jMax,
12       I        trIdentity, trUseGMRedi, trUseKPP,       I        trIdentity, trUseGMRedi, trUseKPP,
13       O        KappaRTr,       O        KappaRTr,
# Line 36  C     == GLobal variables == Line 36  C     == GLobal variables ==
36  #endif  #endif
37  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
38  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
39  #include "PTRACERS.h"  #include "PTRACERS_PARAMS.h"
40    #endif
41    #ifdef ALLOW_LONGSTEP
42    #include "LONGSTEP.h"
43  #endif  #endif
44    
45  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
# Line 63  C     iTr        :: passive tracer index Line 66  C     iTr        :: passive tracer index
66  C     msgBuf     :: message buffer  C     msgBuf     :: message buffer
67        INTEGER i,j,k        INTEGER i,j,k
68        _RL KbryanLewis79        _RL KbryanLewis79
69    #ifdef ALLOW_BL79_LAT_VARY
70          _RL KbryanLewisEQ
71    #endif
72        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
73  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
74        INTEGER iTr        INTEGER iTr
75  #endif  #endif
76  CEOP  CEOP
77    
78        IF ( trIdentity.EQ.GAD_TEMPERATURE) THEN        IF ( .NOT. trUseKPP ) THEN
   
79         DO k = 1,Nr         DO k = 1,Nr
80          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
81       &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)       &       *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
82    #ifdef ALLOW_BL79_LAT_VARY
83            KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
84         &       *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
85    #endif
86          DO j = 1-Oly,sNy+Oly          DO j = 1-Oly,sNy+Oly
87           DO i = 1-Olx,sNx+Olx           DO i = 1-Olx,sNx+Olx
88            KappaRTr(i,j,k) =  #ifdef ALLOW_LONGSTEP
89       &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa            IF ( trIdentity .GE. GAD_TR1) THEN
90  #if (defined ALLOW_3D_DIFFKR || \             KappaRTr(i,j,k) =
91       (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))       &         LS_IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
92       &       + diffKr(i,j,k,bi,bj)       &         + KbryanLewis79
93    #ifdef ALLOW_BL79_LAT_VARY
94         &         + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
95    #endif
96              ELSE
97  #else  #else
98       &       + diffKrNrT(k)            IF ( .TRUE. ) THEN
99    #endif /* ALLOW_LONGSTEP */
100               KappaRTr(i,j,k) =
101         &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
102         &         + KbryanLewis79
103    #ifdef ALLOW_BL79_LAT_VARY
104         &         + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
105  #endif  #endif
106       &       + KbryanLewis79            ENDIF
107           ENDDO           ENDDO
108          ENDDO          ENDDO
109         ENDDO         ENDDO
110           IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
111        ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN          DO k = 1,Nr
112             DO j = 1-Oly,sNy+Oly
113         DO k = 1,Nr            DO i = 1-Olx,sNx+Olx
114          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)             KappaRTr(i,j,k) = KappaRTr(i,j,k)
115       &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)  #ifdef ALLOW_3D_DIFFKR
116          DO j = 1-Oly, sNy+Oly       &          + diffKr(i,j,k,bi,bj)
          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)  
117  #else  #else
118       &       + diffKrNrS(k)       &          + diffKrNrT(k)
119  #endif  #endif
120       &       + KbryanLewis79            ENDDO
121             ENDDO
122            ENDDO
123           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    #ifdef ALLOW_3D_DIFFKR
129         &          + diffKr(i,j,k,bi,bj)
130    #else
131         &          + diffKrNrS(k)
132    #endif
133              ENDDO
134           ENDDO           ENDDO
135          ENDDO          ENDDO
        ENDDO  
   
136  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
137        ELSEIF ( trIdentity.GE.GAD_TR1         ELSEIF ( trIdentity.GE.GAD_TR1) THEN
      &   .AND. trIdentity.LT.GAD_TR1+PTRACERS_numInUse) THEN  
138    
139         iTr = trIdentity - GAD_TR1 + 1          iTr = trIdentity - GAD_TR1 + 1
140         DO k = 1,Nr          DO k = 1,Nr
141          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)           DO j = 1-Oly, sNy+Oly
142       &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)            DO i = 1-Olx, sNx+Olx
143          DO j = 1-Oly, sNy+Oly             KappaRTr(i,j,k) = KappaRTr(i,j,k)
144           DO i = 1-Olx, sNx+Olx  #ifdef ALLOW_3D_DIFFKR
145            KappaRTr(i,j,k) =       &          + diffKr(i,j,k,bi,bj)
      &         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)  
146  #else  #else
147       &       + PTRACERS_diffKrNr(k,iTr)       &          + PTRACERS_diffKrNr(k,iTr)
148  #endif  #endif
149       &       + KbryanLewis79            ENDDO
150           ENDDO           ENDDO
151          ENDDO          ENDDO
        ENDDO  
152  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
153           ELSE
       ELSE  
154          WRITE(msgBuf,'(A,I4)')          WRITE(msgBuf,'(A,I4)')
155       &      ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity       &       ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
156          CALL PRINT_ERROR(msgBuf, myThid)          CALL PRINT_ERROR(msgBuf, myThid)
157          STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'          STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
158           ENDIF
159        ENDIF        ENDIF
160    
161  C--   Add physical pacakge contributions:  C--   Add physical pacakge contributions:
162    
 #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  
   
163  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
164        IF (trUseKPP) THEN        IF (trUseKPP) THEN
165    C--   Set vertical diffusivity contribution from KPP
166         IF (trIdentity.EQ.GAD_TEMPERATURE) THEN         IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
167           CALL KPP_CALC_DIFF_T(           CALL KPP_CALC_DIFF_T(
168       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
169       U        KappaRTr,       O        KappaRTr,
170       I        myThid)       I        myThid)
171         ELSE         ELSEIF (trIdentity.EQ.GAD_SALINITY) THEN
172           CALL KPP_CALC_DIFF_S(           CALL KPP_CALC_DIFF_S(
173       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
174       U        KappaRTr,       O        KappaRTr,
175       I        myThid)       I        myThid)
176    #ifdef ALLOW_PTRACERS
177           ELSEIF ( trIdentity.GE.GAD_TR1) THEN
178             iTr = trIdentity - GAD_TR1 + 1
179             CALL KPP_CALC_DIFF_Ptr(
180         I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
181         O        KappaRTr,
182         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         ENDIF         ENDIF
190        ENDIF        ENDIF
191    #endif /* ALLOW_KPP */
192    
193    #ifdef ALLOW_GMREDI
194          IF (trUseGMRedi) THEN
195             CALL GMREDI_CALC_DIFF(
196         I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
197         U        KappaRTr,
198         I        trIdentity,myThid)
199          ENDIF
200  #endif  #endif
201    
202  #ifdef ALLOW_PP81  #ifdef ALLOW_PP81
# Line 184  C--   Add physical pacakge contributions Line 216  C--   Add physical pacakge contributions
216       I        myThid)       I        myThid)
217        ENDIF        ENDIF
218  #endif  #endif
219          
220  #ifdef ALLOW_GGL90  #ifdef ALLOW_GGL90
221        IF (useGGL90) THEN        IF (useGGL90) THEN
222           CALL GGL90_CALC_DIFF(           CALL GGL90_CALC_DIFF(
# Line 193  C--   Add physical pacakge contributions Line 225  C--   Add physical pacakge contributions
225       I        myThid)       I        myThid)
226        ENDIF        ENDIF
227  #endif  #endif
228          
229  C-    Apply mask to vertical diffusivity  C-    Apply mask to vertical diffusivity
230  C jmc: don't have the impression that masking is needed  C jmc: do not have the impression that masking is needed
231  C      but could be removed later if it's the case.  C      but could be removed later if it is the case.
232  c     DO j = 1-Oly, sNy+Oly  c     DO j = 1-Oly, sNy+Oly
233  c      DO i = 1-Olx, sNx+Olx  c      DO i = 1-Olx, sNx+Olx
234  c       KappaRTr(i,j,k) = maskUp(i,j)*KappaRTr(i,j,k)  c       KappaRTr(i,j,k) = maskUp(i,j)*KappaRTr(i,j,k)
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22