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

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

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

revision 1.1 by jmc, Tue Nov 19 16:58:38 2013 UTC revision 1.18 by jmc, Fri Sep 5 21:07:14 2014 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    #ifdef ALLOW_AUTODIFF
7    # include "AUTODIFF_OPTIONS.h"
8    #endif
9    #ifdef ALLOW_GENERIC_ADVDIFF
10    # include "GAD_OPTIONS.h"
11    #endif
12    
13  CBOP  CBOP
14  C     !ROUTINE: TEMP_INTEGRATE  C     !ROUTINE: TEMP_INTEGRATE
15  C     !INTERFACE:  C     !INTERFACE:
16        SUBROUTINE TEMP_INTEGRATE(        SUBROUTINE TEMP_INTEGRATE(
17       I           bi, bj, iMin, iMax, jMin, jMax,       I           bi, bj, recip_hFac,
18       I           uFld, vFld, wFld, KappaRk,       I           uFld, vFld, wFld,
19         U           KappaRk,
20       I           myTime, myIter, myThid )       I           myTime, myIter, myThid )
21  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
22  C     *==========================================================*  C     *==========================================================*
23  C     | SUBROUTINE TEMP_INTEGRATE  C     | SUBROUTINE TEMP_INTEGRATE
24  C     | o Calculate tendency for temperature  C     | o Calculate tendency for temperature and integrates
25  C     |   and integrates forward in time.  C     |   forward in time. The temperature array is updated here
26    C     |   while adjustments (filters, conv.adjustment) are applied
27    C     |   later, in S/R TRACERS_CORRECTION_STEP.
28  C     *==========================================================*  C     *==========================================================*
29  C     | A procedure called EXTERNAL_FORCING_T is called from  C     | A procedure called APPLY_FORCING_T is called from
30  C     | here. These procedures can be used to add per problem  C     | here. These procedures can be used to add per problem
31  C     | heat flux source terms.  C     | heat flux source terms.
32  C     | Note: Although it is slightly counter-intuitive the  C     | Note: Although it is slightly counter-intuitive the
# Line 34  C     | forms the tendency terms due to Line 43  C     | forms the tendency terms due to
43  C     | The baseline implementation here uses a centered  C     | The baseline implementation here uses a centered
44  C     | difference form for the advection term and a tensorial  C     | difference form for the advection term and a tensorial
45  C     | divergence of a flux form for the diffusive term. The  C     | divergence of a flux form for the diffusive term. The
46  C     | diffusive term is formulated so that isopycnal mixing and  C     | diffusive term is formulated so that isopycnal mixing
47  C     | GM-style subgrid-scale terms can be incorporated b simply  C     | and GM-style subgrid-scale terms can be incorporated by
48  C     | setting the diffusion tensor terms appropriately.  C     | simply setting the diffusion tensor terms appropriately.
49  C     *==========================================================*  C     *==========================================================*
50  C     \ev  C     \ev
51    
# Line 44  C     !USES: Line 53  C     !USES:
53        IMPLICIT NONE        IMPLICIT NONE
54  C     == GLobal variables ==  C     == GLobal variables ==
55  #include "SIZE.h"  #include "SIZE.h"
 #include "DYNVARS.h"  
56  #include "EEPARAMS.h"  #include "EEPARAMS.h"
57  #include "PARAMS.h"  #include "PARAMS.h"
58    #include "GRID.h"
59    #include "DYNVARS.h"
60  #include "RESTART.h"  #include "RESTART.h"
61  #ifdef ALLOW_GENERIC_ADVDIFF  #ifdef ALLOW_GENERIC_ADVDIFF
62  #include "GAD.h"  # include "GAD.h"
63    # include "GAD_SOM_VARS.h"
64  #endif  #endif
65  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_TIMEAVE
66    # include "TIMEAVE_STATV.h"
67    #endif
68    #ifdef ALLOW_AUTODIFF
69  # include "tamc.h"  # include "tamc.h"
70  # include "tamc_keys.h"  # include "tamc_keys.h"
71  #endif  #endif
72    
73  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
74  C     == Routine arguments ==  C     == Routine arguments ==
75  C     bi, bj,   :: tile indices  C     bi, bj,    :: tile indices
76  C     iMin,iMax :: loop range for called routines  C     recip_hFac :: reciprocal of cell open-depth factor (@ next iter)
77  C     jMin,jMax :: loop range for called routines  C     uFld,vFld  :: Local copy of horizontal velocity field
78  C     uFld,vFld :: Local copy of horizontal velocity field  C     wFld       :: Local copy of vertical velocity field
79  C     wFld      :: Local copy of vertical velocity field  C     KappaRk    :: Vertical diffusion for Tempertature
80  C     KappaRk   :: Vertical diffusion for Tempertature  C     myTime     :: current time
81  C     myTime    :: current time  C     myIter     :: current iteration number
82  C     myIter    :: current iteration number  C     myThid     :: my Thread Id. number
83  C     myThid    :: my Thread Id. number        INTEGER bi, bj
84        INTEGER bi, bj, iMin, iMax, jMin, jMax        _RS recip_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
85        _RL uFld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL uFld      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
86        _RL vFld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL vFld      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
87        _RL wFld   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL wFld      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
88        _RL KappaRk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL KappaRk   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
89        _RL     myTime        _RL     myTime
90        INTEGER myIter        INTEGER myIter
91        INTEGER myThid        INTEGER myThid
92  CEOP  CEOP
93    
94  #ifdef ALLOW_GENERIC_ADVDIFF  #ifdef ALLOW_GENERIC_ADVDIFF
95    #ifdef ALLOW_DIAGNOSTICS
96    C     !FUNCTIONS:
97          LOGICAL  DIAGNOSTICS_IS_ON
98          EXTERNAL DIAGNOSTICS_IS_ON
99    #endif /* ALLOW_DIAGNOSTICS */
100    
101  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
102  C     k         :: vertical index  C     iMin, iMax :: 1rst index loop range
103  C     kM1       :: =k-1 for k>1, =1 for k=1  C     jMin, jMax :: 2nd  index loop range
104  C     kUp       :: index into 2 1/2D array, toggles between 1|2  C     k          :: vertical index
105  C     kDown     :: index into 2 1/2D array, toggles between 2|1  C     kM1        :: =k-1 for k>1, =1 for k=1
106  C     xA        :: Tracer cell face area normal to X  C     kUp        :: index into 2 1/2D array, toggles between 1|2
107  C     yA        :: Tracer cell face area normal to X  C     kDown      :: index into 2 1/2D array, toggles between 2|1
108  C     maskUp    :: Land/water mask for Wvel points (interface k)  C     xA         :: Tracer cell face area normal to X
109  C     uTrans    :: Zonal volume transport through cell face  C     yA         :: Tracer cell face area normal to X
110  C     vTrans    :: Meridional volume transport through cell face  C     maskUp     :: Land/water mask for Wvel points (interface k)
111  C     rTrans    ::   Vertical volume transport at interface k  C     uTrans     :: Zonal volume transport through cell face
112  C     rTransKp  :: Vertical volume transport at inteface k+1  C     vTrans     :: Meridional volume transport through cell face
113  C     fVerT     :: Flux of temperature (T) in the vertical direction  C     rTrans     ::   Vertical volume transport at interface k
114  C                  at the upper(U) and lower(D) faces of a cell.  C     rTransKp   :: Vertical volume transport at inteface k+1
115    C     fZon       :: Flux of temperature (T) in the zonal direction
116    C     fMer       :: Flux of temperature (T) in the meridional direction
117    C     fVer       :: Flux of temperature (T) in the vertical direction
118    C                   at the upper(U) and lower(D) faces of a cell.
119    C     gT_loc     :: Temperature tendency (local to this S/R)
120    C     gtForc     :: Temperature forcing tendency
121    C     gt_AB      :: Adams-Bashforth temperature tendency increment
122    C   useVariableK :: T when vertical diffusion is not constant
123          INTEGER iMin, iMax, jMin, jMax
124        INTEGER i, j, k        INTEGER i, j, k
125        INTEGER kUp, kDown, kM1        INTEGER kUp, kDown, kM1
126        _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 101  C                  at the upper(U) and l Line 130  C                  at the upper(U) and l
130        _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
131        _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
132        _RL rTransKp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTransKp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
133        _RL fVerT   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)        _RL fZon    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
134          _RL fMer    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
135          _RL fVer    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
136          _RL gT_loc  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
137          _RL gtForc  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
138        _RL gt_AB   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL gt_AB   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
139    #ifdef ALLOW_DIAGNOSTICS
140          LOGICAL diagForcing, diagAB_tend
141    #endif
142        LOGICAL calcAdvection        LOGICAL calcAdvection
143        INTEGER iterNb        INTEGER iterNb
144  #ifdef ALLOW_ADAMSBASHFORTH_3  #ifdef ALLOW_ADAMSBASHFORTH_3
145        INTEGER m1, m2        INTEGER m2
146    #endif
147    #ifdef ALLOW_TIMEAVE
148          LOGICAL useVariableK
149    #endif
150    
151    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
152    
153          iterNb = myIter
154          IF (staggerTimeStep) iterNb = myIter - 1
155    
156    C-    Loop ranges for daughter routines:
157    c     iMin = 1
158    c     iMax = sNx
159    c     jMin = 1
160    c     jMax = sNy
161    C     Regarding model dynamics, only needs to get correct tracer tendency
162    C     (gT_loc) in tile interior (1:sNx,1:sNy);
163    C     However, for some diagnostics, we may want to get valid tendency
164    C     extended over 1 point in tile halo region (0:sNx+1,0:sNy=1).
165          iMin = 0
166          iMax = sNx+1
167          jMin = 0
168          jMax = sNy+1
169    
170    #ifdef ALLOW_DIAGNOSTICS
171          diagForcing = .FALSE.
172          diagAB_tend = .FALSE.
173          IF ( useDiagnostics .AND. tempForcing )
174         &     diagForcing = DIAGNOSTICS_IS_ON( 'gT_Forc ', myThid )
175          IF ( useDiagnostics .AND. AdamsBashforthGt )
176         &     diagAB_tend = DIAGNOSTICS_IS_ON( 'AB_gT   ', myThid )
177  #endif  #endif
178    
179  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 122  C                  at the upper(U) and l Line 189  C                  at the upper(U) and l
189       &                      + act4*max1*max2*max3       &                      + act4*max1*max2*max3
190  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
191    
192  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C-    Apply AB on T :
193          IF ( AdamsBashforth_T ) THEN
194        calcAdvection = tempAdvection .AND. .NOT.tempMultiDimAdvec  C     compute T^n+1/2 (stored in gtNm) extrapolating T forward in time
195        iterNb = myIter  #ifdef ALLOW_ADAMSBASHFORTH_3
196        IF (staggerTimeStep) iterNb = myIter -1  c         m1 = 1 + MOD(iterNb+1,2)
197    c         m2 = 1 + MOD( iterNb ,2)
198              CALL ADAMS_BASHFORTH3(
199         I                           bi, bj, 0, Nr,
200         I                           theta(1-OLx,1-OLy,1,bi,bj),
201         U                           gtNm, gt_AB,
202         I                           tempStartAB, iterNb, myThid )
203    #else /* ALLOW_ADAMSBASHFORTH_3 */
204              CALL ADAMS_BASHFORTH2(
205         I                           bi, bj, 0, Nr,
206         I                           theta(1-OLx,1-OLy,1,bi,bj),
207         U                           gtNm1(1-OLx,1-OLy,1,bi,bj), gt_AB,
208         I                           tempStartAB, iterNb, myThid )
209    #endif /* ALLOW_ADAMSBASHFORTH_3 */
210          ENDIF
211    
212    C-    Tracer tendency needs to be set to zero (moved here from gad_calc_rhs):
213          DO k=1,Nr
214           DO j=1-OLy,sNy+OLy
215            DO i=1-OLx,sNx+OLx
216             gT_loc(i,j,k) = 0. _d 0
217            ENDDO
218           ENDDO
219          ENDDO
220        DO j=1-OLy,sNy+OLy        DO j=1-OLy,sNy+OLy
221         DO i=1-OLx,sNx+OLx         DO i=1-OLx,sNx+OLx
222           fVerT(i,j,1) = 0. _d 0           fVer(i,j,1) = 0. _d 0
223           fVerT(i,j,2) = 0. _d 0           fVer(i,j,2) = 0. _d 0
224         ENDDO         ENDDO
225        ENDDO        ENDDO
226    #ifdef ALLOW_AUTODIFF
227          DO k=1,Nr
228           DO j=1-OLy,sNy+OLy
229            DO i=1-OLx,sNx+OLx
230             kappaRk(i,j,k) = 0. _d 0
231            ENDDO
232           ENDDO
233          ENDDO
234    CADJ STORE wFld(:,:,:)         = comlev1_bibj , key=itdkey, byte=isbyte
235    CADJ STORE theta(:,:,:,bi,bj)  = comlev1_bibj , key=itdkey, byte=isbyte
236    # ifdef ALLOW_ADAMSBASHFORTH_3
237    CADJ STORE gtNm(:,:,:,bi,bj,1) = comlev1_bibj, key=itdkey, byte=isbyte
238    CADJ STORE gtNm(:,:,:,bi,bj,2) = comlev1_bibj, key=itdkey, byte=isbyte
239    # else
240    CADJ STORE gtNm1(:,:,:,bi,bj)  = comlev1_bibj, key=itdkey, byte=isbyte
241    # endif
242    #endif /* ALLOW_AUTODIFF */
243    
244    #ifdef INCLUDE_CALC_DIFFUSIVITY_CALL
245          CALL CALC_3D_DIFFUSIVITY(
246         I         bi, bj, iMin, iMax, jMin, jMax,
247         I         GAD_TEMPERATURE, useGMredi, useKPP,
248         O         kappaRk,
249         I         myThid )
250    #endif /* INCLUDE_CALC_DIFFUSIVITY_CALL */
251    
252    #ifndef DISABLE_MULTIDIM_ADVECTION
253    C--     Some advection schemes are better calculated using a multi-dimensional
254    C       method in the absence of any other terms and, if used, is done here.
255    C
256    C The CPP flag DISABLE_MULTIDIM_ADVECTION is currently unset in GAD_OPTIONS.h
257    C The default is to use multi-dimensinal advection for non-linear advection
258    C schemes. However, for the sake of efficiency of the adjoint it is necessary
259    C to be able to exclude this scheme to avoid excessive storage and
260    C recomputation. It *is* differentiable, if you need it.
261    C Edit GAD_OPTIONS.h and #define DISABLE_MULTIDIM_ADVECTION to
262    C disable this section of code.
263    #ifdef GAD_ALLOW_TS_SOM_ADV
264    # ifdef ALLOW_AUTODIFF_TAMC
265    CADJ STORE som_T = comlev1_bibj, key=itdkey, byte=isbyte
266    # endif
267          IF ( tempSOM_Advection ) THEN
268    # ifdef ALLOW_DEBUG
269            IF (debugMode) CALL DEBUG_CALL('GAD_SOM_ADVECT',myThid)
270    # endif
271            CALL GAD_SOM_ADVECT(
272         I             tempImplVertAdv,
273         I             tempAdvScheme, tempVertAdvScheme, GAD_TEMPERATURE,
274         I             dTtracerLev, uFld, vFld, wFld, theta,
275         U             som_T,
276         O             gT_loc,
277         I             bi, bj, myTime, myIter, myThid )
278          ELSEIF (tempMultiDimAdvec) THEN
279    #else /* GAD_ALLOW_TS_SOM_ADV */
280          IF (tempMultiDimAdvec) THEN
281    #endif /* GAD_ALLOW_TS_SOM_ADV */
282    # ifdef ALLOW_DEBUG
283            IF (debugMode) CALL DEBUG_CALL('GAD_ADVECTION',myThid)
284    # endif
285            CALL GAD_ADVECTION(
286         I             tempImplVertAdv,
287         I             tempAdvScheme, tempVertAdvScheme, GAD_TEMPERATURE,
288         I             dTtracerLev, uFld, vFld, wFld, theta,
289         O             gT_loc,
290         I             bi, bj, myTime, myIter, myThid )
291          ENDIF
292    #endif /* DISABLE_MULTIDIM_ADVECTION */
293    
294    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
295    
296    C-    Start vertical index (k) loop (Nr:1)
297          calcAdvection = tempAdvection .AND. .NOT.tempMultiDimAdvec
298        DO k=Nr,1,-1        DO k=Nr,1,-1
299  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
300          kkey = (itdkey-1)*Nr + k          kkey = (itdkey-1)*Nr + k
# Line 144  C---+----1----+----2----+----3----+----4 Line 304  C---+----1----+----2----+----3----+----4
304          kDown= 1+MOD(k,2)          kDown= 1+MOD(k,2)
305    
306  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
307  CADJ STORE rtrans(:,:) = comlev1_bibj_k, key=kkey,  CADJ STORE fVer(:,:,:) = comlev1_bibj_k, key=kkey,
308  CADJ &     byte=isbyte,  kind = isbyte  CADJ &     byte=isbyte,  kind = isbyte
309  CADJ STORE fVerT(:,:,:) = comlev1_bibj_k, key=kkey,  CADJ STORE gT_loc(:,:,k) = comlev1_bibj_k, key=kkey,
 CADJ &     byte=isbyte,  kind = isbyte  
 CADJ STORE gT(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey,  
310  CADJ &     byte=isbyte,  kind = isbyte  CADJ &     byte=isbyte,  kind = isbyte
311  # ifdef ALLOW_ADAMSBASHFORTH_3  # ifdef ALLOW_ADAMSBASHFORTH_3
312  CADJ STORE gtNm(:,:,k,bi,bj,1) = comlev1_bibj_k, key=kkey,  CADJ STORE gtNm(:,:,k,bi,bj,1) = comlev1_bibj_k, key=kkey,
# Line 167  CADJ &     byte=isbyte,  kind = isbyte Line 325  CADJ &     byte=isbyte,  kind = isbyte
325       O                maskUp, xA, yA,       O                maskUp, xA, yA,
326       I                k, bi, bj, myThid )       I                k, bi, bj, myThid )
327    
328    C--   Collect forcing term in local array gtForc:
329            DO j=1-OLy,sNy+OLy
330             DO i=1-OLx,sNx+OLx
331              gtForc(i,j) = 0. _d 0
332             ENDDO
333            ENDDO
334            IF ( tempForcing ) THEN
335              CALL APPLY_FORCING_T(
336         U                        gtForc,
337         I                        iMin,iMax,jMin,jMax, k, bi,bj,
338         I                        myTime, myIter, myThid )
339    #ifdef ALLOW_DIAGNOSTICS
340              IF ( diagForcing ) THEN
341                CALL DIAGNOSTICS_FILL(gtForc,'gT_Forc ',k,1,2,bi,bj,myThid)
342              ENDIF
343    #endif /* ALLOW_DIAGNOSTICS */
344            ENDIF
345    
346  #ifdef ALLOW_ADAMSBASHFORTH_3  #ifdef ALLOW_ADAMSBASHFORTH_3
347          m1 = 1 + MOD(iterNb+1,2)  c       m1 = 1 + MOD(iterNb+1,2)
348          m2 = 1 + MOD( iterNb ,2)          m2 = 1 + MOD( iterNb ,2)
349          CALL GAD_CALC_RHS(          CALL GAD_CALC_RHS(
350       I           bi, bj, iMin,iMax,jMin,jMax, k, kM1, kUp, kDown,       I           bi, bj, iMin,iMax,jMin,jMax, k, kM1, kUp, kDown,
# Line 176  CADJ &     byte=isbyte,  kind = isbyte Line 352  CADJ &     byte=isbyte,  kind = isbyte
352       I           vFld(1-OLx,1-OLy,k), wFld(1-OLx,1-OLy,k),       I           vFld(1-OLx,1-OLy,k), wFld(1-OLx,1-OLy,k),
353       I           uTrans, vTrans, rTrans, rTransKp,       I           uTrans, vTrans, rTrans, rTransKp,
354       I           diffKhT, diffK4T, KappaRk(1-OLx,1-OLy,k), diffKr4T,       I           diffKhT, diffK4T, KappaRk(1-OLx,1-OLy,k), diffKr4T,
355       I           gtNm(1-OLx,1-OLy,1,1,1,m2), theta, dTtracerLev,       I           theta(1-OLx,1-OLy,1,bi,bj),
356         I           gtNm(1-OLx,1-OLy,1,bi,bj,m2), dTtracerLev,
357       I           GAD_TEMPERATURE, tempAdvScheme, tempVertAdvScheme,       I           GAD_TEMPERATURE, tempAdvScheme, tempVertAdvScheme,
358       I           calcAdvection, tempImplVertAdv, AdamsBashforth_T,       I           calcAdvection, tempImplVertAdv, AdamsBashforth_T,
359       I           tempVertDiff4, useGMRedi, useKPP,       I           tempVertDiff4, useGMRedi, useKPP,
360       U           fVerT, gT,       O           fZon, fMer,
361         U           fVer, gT_loc,
362       I           myTime, myIter, myThid )       I           myTime, myIter, myThid )
363  #else /* ALLOW_ADAMSBASHFORTH_3 */  #else /* ALLOW_ADAMSBASHFORTH_3 */
364          CALL GAD_CALC_RHS(          CALL GAD_CALC_RHS(
# Line 189  CADJ &     byte=isbyte,  kind = isbyte Line 367  CADJ &     byte=isbyte,  kind = isbyte
367       I           vFld(1-OLx,1-OLy,k), wFld(1-OLx,1-OLy,k),       I           vFld(1-OLx,1-OLy,k), wFld(1-OLx,1-OLy,k),
368       I           uTrans, vTrans, rTrans, rTransKp,       I           uTrans, vTrans, rTrans, rTransKp,
369       I           diffKhT, diffK4T, KappaRk(1-OLx,1-OLy,k), diffKr4T,       I           diffKhT, diffK4T, KappaRk(1-OLx,1-OLy,k), diffKr4T,
370       I           gtNm1, theta, dTtracerLev,       I           theta(1-OLx,1-OLy,1,bi,bj),
371         I           gtNm1(1-OLx,1-OLy,1,bi,bj), dTtracerLev,
372       I           GAD_TEMPERATURE, tempAdvScheme, tempVertAdvScheme,       I           GAD_TEMPERATURE, tempAdvScheme, tempVertAdvScheme,
373       I           calcAdvection, tempImplVertAdv, AdamsBashforth_T,       I           calcAdvection, tempImplVertAdv, AdamsBashforth_T,
374       I           tempVertDiff4, useGMRedi, useKPP,       I           tempVertDiff4, useGMRedi, useKPP,
375       U           fVerT, gT,       O           fZon, fMer,
376         U           fVer, gT_loc,
377       I           myTime, myIter, myThid )       I           myTime, myIter, myThid )
378  #endif  #endif
379    
380  C--   External thermal forcing term(s) inside Adams-Bashforth:  C--   External thermal forcing term(s) inside Adams-Bashforth:
381          IF ( tempForcing .AND. tracForcingOutAB.NE.1 )          IF ( tempForcing .AND. tracForcingOutAB.NE.1 ) THEN
382       &    CALL EXTERNAL_FORCING_T(            DO j=1-OLy,sNy+OLy
383       I         iMin, iMax, jMin, jMax, bi, bj, k,             DO i=1-OLx,sNx+OLx
384       I         myTime, myThid )              gT_loc(i,j,k) = gT_loc(i,j,k) + gtForc(i,j)
385               ENDDO
386              ENDDO
387            ENDIF
388    
389          IF ( AdamsBashforthGt ) THEN          IF ( AdamsBashforthGt ) THEN
390  #ifdef ALLOW_ADAMSBASHFORTH_3  #ifdef ALLOW_ADAMSBASHFORTH_3
391            CALL ADAMS_BASHFORTH3(            CALL ADAMS_BASHFORTH3(
392       I                          bi, bj, k, Nr,       I                          bi, bj, k, Nr,
393       U                          gT, gtNm, gt_AB,       U                          gT_loc, gtNm,
394         O                          gt_AB,
395       I                          tempStartAB, iterNb, myThid )       I                          tempStartAB, iterNb, myThid )
396  #else  #else
397            CALL ADAMS_BASHFORTH2(            CALL ADAMS_BASHFORTH2(
398       I                          bi, bj, k, Nr,       I                          bi, bj, k, Nr,
399       U                          gT, gtNm1, gt_AB,       U                          gT_loc, gtNm1(1-OLx,1-OLy,1,bi,bj),
400         O                          gt_AB,
401       I                          tempStartAB, iterNb, myThid )       I                          tempStartAB, iterNb, myThid )
402  #endif  #endif
403  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
404            IF ( useDiagnostics ) THEN            IF ( diagAB_tend ) THEN
405              CALL DIAGNOSTICS_FILL(gt_AB,'AB_gT   ',k,1,2,bi,bj,myThid)              CALL DIAGNOSTICS_FILL(gt_AB,'AB_gT   ',k,1,2,bi,bj,myThid)
406            ENDIF            ENDIF
407  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
408          ENDIF          ENDIF
409    
410  C--   External thermal forcing term(s) outside Adams-Bashforth:  C--   External thermal forcing term(s) outside Adams-Bashforth:
411          IF ( tempForcing .AND. tracForcingOutAB.EQ.1 )          IF ( tempForcing .AND. tracForcingOutAB.EQ.1 ) THEN
412       &    CALL EXTERNAL_FORCING_T(            DO j=1-OLy,sNy+OLy
413       I         iMin, iMax, jMin, jMax, bi, bj, k,             DO i=1-OLx,sNx+OLx
414       I         myTime, myThid )              gT_loc(i,j,k) = gT_loc(i,j,k) + gtForc(i,j)
415               ENDDO
416              ENDDO
417            ENDIF
418    
419  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
420          IF (nonlinFreeSurf.GT.0) THEN          IF (nonlinFreeSurf.GT.0) THEN
421            CALL FREESURF_RESCALE_G(            CALL FREESURF_RESCALE_G(
422       I                            bi, bj, k,       I                            bi, bj, k,
423       U                            gT,       U                            gT_loc,
424       I                            myThid )       I                            myThid )
425           IF ( AdamsBashforthGt ) THEN           IF ( AdamsBashforthGt ) THEN
426  #ifdef ALLOW_ADAMSBASHFORTH_3  #ifdef ALLOW_ADAMSBASHFORTH_3
# Line 244  CADJ &     byte=isbyte,  kind = isbyte Line 432  CADJ &     byte=isbyte,  kind = isbyte
432  # endif  # endif
433            CALL FREESURF_RESCALE_G(            CALL FREESURF_RESCALE_G(
434       I                            bi, bj, k,       I                            bi, bj, k,
435       U                            gtNm(1-OLx,1-OLy,1,1,1,1),       U                            gtNm(1-OLx,1-OLy,1,bi,bj,1),
436       I                            myThid )       I                            myThid )
437            CALL FREESURF_RESCALE_G(            CALL FREESURF_RESCALE_G(
438       I                            bi, bj, k,       I                            bi, bj, k,
439       U                            gtNm(1-OLx,1-OLy,1,1,1,2),       U                            gtNm(1-OLx,1-OLy,1,bi,bj,2),
440       I                            myThid )       I                            myThid )
441  #else  #else
442            CALL FREESURF_RESCALE_G(            CALL FREESURF_RESCALE_G(
443       I                            bi, bj, k,       I                            bi, bj, k,
444       U                            gtNm1,       U                            gtNm1(1-OLx,1-OLy,1,bi,bj),
445       I                            myThid )       I                            myThid )
446  #endif  #endif
447           ENDIF           ENDIF
448          ENDIF          ENDIF
449  #endif /* NONLIN_FRSURF */  #endif /* NONLIN_FRSURF */
450    
451  #ifdef ALLOW_ADAMSBASHFORTH_3  C-    end of vertical index (k) loop (Nr:1)
452          IF ( AdamsBashforth_T ) THEN        ENDDO
453            CALL TIMESTEP_TRACER(  
454       I           bi, bj, k, dTtracerLev(k),  #ifdef ALLOW_DOWN_SLOPE
455       I           gtNm(1-OLx,1-OLy,1,1,1,m2),        IF ( useDOWN_SLOPE ) THEN
456       U           gT,          IF ( usingPCoords ) THEN
457       I           myIter, myThid )            CALL DWNSLP_APPLY(
458         I                  GAD_TEMPERATURE, bi, bj, kSurfC,
459         I                  theta(1-OLx,1-OLy,1,bi,bj),
460         U                  gT_loc,
461         I                  recip_hFac, recip_rA, recip_drF,
462         I                  dTtracerLev, myTime, myIter, myThid )
463          ELSE          ELSE
464  #endif            CALL DWNSLP_APPLY(
465            CALL TIMESTEP_TRACER(       I                  GAD_TEMPERATURE, bi, bj, kLowC,
466       I           bi, bj, k, dTtracerLev(k),       I                  theta(1-OLx,1-OLy,1,bi,bj),
467       I           theta,       U                  gT_loc,
468       U           gT,       I                  recip_hFac, recip_rA, recip_drF,
469       I           myIter, myThid )       I                  dTtracerLev, myTime, myIter, myThid )
 #ifdef ALLOW_ADAMSBASHFORTH_3  
470          ENDIF          ENDIF
471  #endif        ENDIF
472    #endif /* ALLOW_DOWN_SLOPE */
473    
474  C-    end of vertical index (k) loop (Nr:1)  C-    Integrate forward in time, storing in gT_loc:  gT <= T + dt*gT
475        ENDDO        CALL TIMESTEP_TRACER(
476         I                  bi, bj, dTtracerLev,
477         I                  theta(1-OLx,1-OLy,1,bi,bj),
478         U                  gT_loc,
479         I                  myTime, myIter, myThid )
480    
481    C--   Implicit vertical advection & diffusion
482    
483    #ifdef INCLUDE_IMPLVERTADV_CODE
484          IF ( tempImplVertAdv ) THEN
485    #ifdef ALLOW_AUTODIFF_TAMC
486    CADJ STORE kappaRk(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
487    CADJ STORE gT_loc(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
488    CADJ STORE wFld(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
489    CADJ STORE theta(:,:,:,bi,bj) = comlev1_bibj , key=itdkey, byte=isbyte
490    CADJ STORE recip_hFac(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
491    #endif /* ALLOW_AUTODIFF_TAMC */
492            CALL GAD_IMPLICIT_R(
493         I         tempImplVertAdv, tempVertAdvScheme, GAD_TEMPERATURE,
494         I         dTtracerLev, kappaRk, recip_hFac, wFld,
495         I         theta(1-OLx,1-OLy,1,bi,bj),
496         U         gT_loc,
497         I         bi, bj, myTime, myIter, myThid )
498          ELSEIF ( implicitDiffusion ) THEN
499    #else /* INCLUDE_IMPLVERTADV_CODE */
500          IF     ( implicitDiffusion ) THEN
501    #endif /* INCLUDE_IMPLVERTADV_CODE */
502    #ifdef ALLOW_AUTODIFF_TAMC
503    CADJ STORE kappaRk(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
504    CADJ STORE gT_loc(:,:,:) = comlev1_bibj , key=itdkey, byte=isbyte
505    #endif /* ALLOW_AUTODIFF_TAMC */
506            CALL IMPLDIFF(
507         I         bi, bj, iMin, iMax, jMin, jMax,
508         I         GAD_TEMPERATURE, kappaRk, recip_hFac,
509         U         gT_loc,
510         I         myThid )
511          ENDIF
512    
513    #ifdef ALLOW_TIMEAVE
514          useVariableK = useKPP .OR. usePP81 .OR. useKL10 .OR. useMY82
515         &       .OR. useGGL90 .OR. useGMredi .OR. ivdc_kappa.NE.0.
516          IF ( taveFreq.GT.0. .AND. useVariableK
517         &                    .AND.implicitDiffusion ) THEN
518            CALL TIMEAVE_CUMUL_DIF_1T( TdiffRtave,
519         I                        gT_loc, kappaRk,
520         I                        Nr, 3, deltaTClock, bi, bj, myThid )
521          ENDIF
522    #endif /* ALLOW_TIMEAVE */
523    
524          IF ( AdamsBashforth_T ) THEN
525    C-    Save current tracer field (for AB on tracer) and then update tracer
526    #ifdef ALLOW_ADAMSBASHFORTH_3
527            CALL CYCLE_AB_TRACER(
528         I             bi, bj, gT_loc,
529         U             theta(1-OLx,1-OLy,1,bi,bj),
530         O             gtNm(1-OLx,1-OLy,1,bi,bj,m2),
531         I             myTime, myIter, myThid )
532    #else /* ALLOW_ADAMSBASHFORTH_3 */
533            CALL CYCLE_AB_TRACER(
534         I             bi, bj, gT_loc,
535         U             theta(1-OLx,1-OLy,1,bi,bj),
536         O             gtNm1(1-OLx,1-OLy,1,bi,bj),
537         I             myTime, myIter, myThid )
538    #endif /* ALLOW_ADAMSBASHFORTH_3 */
539          ELSE
540    C-    Update tracer fields:  T(n) = T**
541            CALL CYCLE_TRACER(
542         I             bi, bj,
543         O             theta(1-OLx,1-OLy,1,bi,bj),
544         I             gT_loc, myTime, myIter, myThid )
545          ENDIF
546    
547  #endif /* ALLOW_GENERIC_ADVDIFF */  #endif /* ALLOW_GENERIC_ADVDIFF */
548    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22