/[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.3 by jmc, Fri Dec 3 15:39:11 2004 UTC revision 1.12 by dimitri, Thu Sep 27 14:42:59 2007 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 62  C     i, j, k    :: Loop counters Line 62  C     i, j, k    :: Loop counters
62  C     iTr        :: passive tracer index  C     iTr        :: passive tracer index
63  C     msgBuf     :: message buffer  C     msgBuf     :: message buffer
64        INTEGER i,j,k        INTEGER i,j,k
       INTEGER iTr  
65        _RL KbryanLewis79        _RL KbryanLewis79
66    #ifdef ALLOW_BL79_LAT_VARY
67          _RL KbryanLewisEQ
68    #endif
69        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
70    #ifdef ALLOW_PTRACERS
71          INTEGER iTr
72    #endif
73  CEOP  CEOP
74    
75        IF ( trIdentity.EQ.GAD_TEMPERATURE) THEN        IF ( .NOT. trUseKPP ) THEN
   
76         DO k = 1,Nr         DO k = 1,Nr
77          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)
78       &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)       &       *(atan(-(rF(k)-diffKrBL79Ho)/diffKrBL79scl)/PI+0.5 _d 0)
79    #ifdef ALLOW_BL79_LAT_VARY
80            KbryanLewisEQ=diffKrBLEQsurf+(diffKrBLEQdeep-diffKrBLEQsurf)
81         &       *(atan(-(rF(k)-diffKrBLEQHo)/diffKrBLEQscl)/PI+0.5 _d 0)
82    #endif
83          DO j = 1-Oly,sNy+Oly          DO j = 1-Oly,sNy+Oly
84           DO i = 1-Olx,sNx+Olx           DO i = 1-Olx,sNx+Olx
85            KappaRTr(i,j,k) =            KappaRTr(i,j,k) =
86       &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa       &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa
87  #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL))       &         + KbryanLewis79
88       &       + diffKr(i,j,k,bi,bj)  #ifdef ALLOW_BL79_LAT_VARY
89  #else       &         + (KbryanLewisEQ-KbryanLewis79)*BL79LatArray(i,j,bi,bj)
      &       + diffKrNrT(k)  
90  #endif  #endif
      &       + KbryanLewis79  
91           ENDDO           ENDDO
92          ENDDO          ENDDO
93         ENDDO         ENDDO
94           IF ( trIdentity.EQ.GAD_TEMPERATURE ) THEN
95        ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN          DO k = 1,Nr
96             DO j = 1-Oly,sNy+Oly
97         DO k = 1,Nr            DO i = 1-Olx,sNx+Olx
98          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)             KappaRTr(i,j,k) = KappaRTr(i,j,k)
99       &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)  #if (defined ALLOW_3D_DIFFKR || \
100          DO j = 1-Oly, sNy+Oly       (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
101           DO i = 1-Olx, sNx+Olx       &          + diffKr(i,j,k,bi,bj)
           KappaRTr(i,j,k) =  
      &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa  
 #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL))  
      &       + diffKr(i,j,k,bi,bj)  
102  #else  #else
103       &       + diffKrNrS(k)       &          + diffKrNrT(k)
104  #endif  #endif
105       &       + KbryanLewis79            ENDDO
106             ENDDO
107            ENDDO
108           ELSEIF ( trIdentity.EQ.GAD_SALINITY) THEN
109            DO k = 1,Nr
110             DO j = 1-Oly, sNy+Oly
111              DO i = 1-Olx, sNx+Olx
112               KappaRTr(i,j,k) = KappaRTr(i,j,k)
113    #if (defined ALLOW_3D_DIFFKR || \
114         (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
115         &          + diffKr(i,j,k,bi,bj)
116    #else
117         &          + diffKrNrS(k)
118    #endif
119              ENDDO
120           ENDDO           ENDDO
121          ENDDO          ENDDO
        ENDDO  
   
122  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
123        ELSEIF ( trIdentity.GE.GAD_TR1         ELSEIF ( trIdentity.GE.GAD_TR1
124       &   .AND. trIdentity.LT.GAD_TR1+PTRACERS_numInUse) THEN       &   .AND. trIdentity.LT.GAD_TR1+PTRACERS_numInUse) THEN
125    
126         iTr = trIdentity - GAD_TR1 + 1          iTr = trIdentity - GAD_TR1 + 1
127         DO k = 1,Nr          DO k = 1,Nr
128          KbryanLewis79=diffKrBL79surf+(diffKrBL79deep-diffKrBL79surf)           DO j = 1-Oly, sNy+Oly
129       &  *( atan( -( rF(k)-diffKrBL79Ho )/diffKrBL79scl )/PI+0.5 _d 0)            DO i = 1-Olx, sNx+Olx
130          DO j = 1-Oly, sNy+Oly             KappaRTr(i,j,k) = KappaRTr(i,j,k)
131           DO i = 1-Olx, sNx+Olx  #if (defined ALLOW_3D_DIFFKR || \
132            KappaRTr(i,j,k) =       (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL)))
133       &         IVDConvCount(i,j,k,bi,bj)*ivdc_kappa       &          + diffKr(i,j,k,bi,bj)
 #if (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL))  
      &       + diffKr(i,j,k,bi,bj)  
134  #else  #else
135       &       + PTRACERS_diffKrNr(k,iTr)       &          + PTRACERS_diffKrNr(k,iTr)
136  #endif  #endif
137       &       + KbryanLewis79            ENDDO
138           ENDDO           ENDDO
139          ENDDO          ENDDO
        ENDDO  
140  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
141           ELSE
       ELSE  
142          WRITE(msgBuf,'(A,I4)')          WRITE(msgBuf,'(A,I4)')
143       &      ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity       &       ' CALC_3D_DIFFUSIVITY: Invalid tracer Id: ',trIdentity
144          CALL PRINT_ERROR(msgBuf, myThid)          CALL PRINT_ERROR(msgBuf, myThid)
145          STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'          STOP 'ABNORMAL END: S/R CALC_3D_DIFFUSIVITY'
146           ENDIF
147        ENDIF        ENDIF
148    
149  C--   Add physical pacakge contributions:  C--   Add physical pacakge contributions:
150    
 #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  
   
151  #ifdef ALLOW_KPP  #ifdef ALLOW_KPP
152        IF (trUseKPP) THEN        IF (trUseKPP) THEN
153    C--   Set vertical diffusivity contribution from KPP
154         IF (trIdentity.EQ.GAD_TEMPERATURE) THEN         IF (trIdentity.EQ.GAD_TEMPERATURE) THEN
155           CALL KPP_CALC_DIFF_T(           CALL KPP_CALC_DIFF_T(
156       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
157       U        KappaRTr,       O        KappaRTr,
158       I        myThid)       I        myThid)
159         ELSE         ELSE
160           CALL KPP_CALC_DIFF_S(           CALL KPP_CALC_DIFF_S(
161       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,       I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
162       U        KappaRTr,       O        KappaRTr,
163       I        myThid)       I        myThid)
164         ENDIF         ENDIF
165    #if (defined ALLOW_PTRACERS && ! (defined ALLOW_3D_DIFFKR || \
166         (defined (ALLOW_AUTODIFF_TAMC) && defined (ALLOW_DIFFKR_CONTROL))))
167           IF ( trIdentity.GE.GAD_TR1
168         &   .AND. trIdentity.LT.GAD_TR1+PTRACERS_numInUse) THEN
169            iTr = trIdentity - GAD_TR1 + 1
170            DO k = 1,Nr
171             DO j = 1-Oly, sNy+Oly
172              DO i = 1-Olx, sNx+Olx
173               KappaRTr(i,j,k) = KappaRTr(i,j,k)
174         &          - diffKrNrS(k) + PTRACERS_diffKrNr(k,iTr)
175              ENDDO
176             ENDDO
177            ENDDO
178           ENDIF
179    #endif
180          ENDIF
181    #endif /* ALLOW_KPP */
182    
183    #ifdef ALLOW_GMREDI
184          IF (trUseGMRedi) THEN
185             CALL GMREDI_CALC_DIFF(
186         I        bi,bj,iMin,iMax,jMin,jMax,0,Nr,
187         U        KappaRTr,
188         I        myThid)
189        ENDIF        ENDIF
190  #endif  #endif
191    
# Line 179  C--   Add physical pacakge contributions Line 206  C--   Add physical pacakge contributions
206       I        myThid)       I        myThid)
207        ENDIF        ENDIF
208  #endif  #endif
209          
210  #ifdef ALLOW_GGL90  #ifdef ALLOW_GGL90
211        IF (useGGL90) THEN        IF (useGGL90) THEN
212           CALL GGL90_CALC_DIFF(           CALL GGL90_CALC_DIFF(
# Line 188  C--   Add physical pacakge contributions Line 215  C--   Add physical pacakge contributions
215       I        myThid)       I        myThid)
216        ENDIF        ENDIF
217  #endif  #endif
218          
219  C-    Apply mask to vertical diffusivity  C-    Apply mask to vertical diffusivity
220  C jmc: don't have the impression that masking is needed  C jmc: don't have the impression that masking is needed
221  C      but could be removed later if it's the case.  C      but could be removed later if it's the case.
222  c     DO j = 1-Oly, sNy+Oly  c     DO j = 1-Oly, sNy+Oly
223  c      DO i = 1-Olx, sNx+Olx  c      DO i = 1-Olx, sNx+Olx
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22