/[MITgcm]/MITgcm/pkg/ptracers/ptracers_integrate.F
ViewVC logotype

Diff of /MITgcm/pkg/ptracers/ptracers_integrate.F

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

revision 1.7 by heimbach, Fri Jun 27 01:56:17 2003 UTC revision 1.52 by jmc, Fri Dec 27 15:51:26 2013 UTC
# Line 2  C $Header$ Line 2  C $Header$
2  C $Name$  C $Name$
3    
4  #include "PTRACERS_OPTIONS.h"  #include "PTRACERS_OPTIONS.h"
 cswdptr -- add ---  
 #ifdef ALLOW_GCHEM  
 # include "GCHEM_OPTIONS.h"  
 #endif  
 cswdptr -- end add ---  
5    
6  CBOP  CBOP
7  C !ROUTINE: PTRACERS_INTEGRATE  C !ROUTINE: PTRACERS_INTEGRATE
8    
9  C !INTERFACE: ==========================================================  C !INTERFACE: ==========================================================
10        SUBROUTINE PTRACERS_INTEGRATE(        SUBROUTINE PTRACERS_INTEGRATE(
11       I                               bi,bj,k,       I                    bi, bj, recip_hFac,
12       I                               xA,yA,uTrans,vTrans,rTrans,maskUp,       I                    uFld, vFld, wFld,
13       X                               KappaRtr,       U                    KappaRk,
14       I                               myIter,myTime,myThid )       I                    myTime, myIter, myThid )
15    
16  C !DESCRIPTION:  C !DESCRIPTION:
17  C     Calculates tendancy for passive tracers and integrates forward  C     Calculates tendency for passive tracers and integrates forward
18  C     in time.  C     in time.
19    
20  C !USES: ===============================================================  C !USES: ===============================================================
21    #include "PTRACERS_MOD.h"
22        IMPLICIT NONE        IMPLICIT NONE
23  #include "SIZE.h"  #include "SIZE.h"
24  #include "EEPARAMS.h"  #include "EEPARAMS.h"
25  #include "PARAMS.h"  #include "PARAMS.h"
26  #include "PTRACERS.h"  #include "GRID.h"
27    #ifdef ALLOW_LONGSTEP
28    #include "LONGSTEP_PARAMS.h"
29    #endif
30    #include "PTRACERS_SIZE.h"
31    #include "PTRACERS_PARAMS.h"
32    #include "PTRACERS_START.h"
33    #include "PTRACERS_FIELDS.h"
34  #include "GAD.h"  #include "GAD.h"
35    #ifdef ALLOW_AUTODIFF_TAMC
36    # include "tamc.h"
37    # include "tamc_keys.h"
38    #endif
39    
40  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
41  C  bi,bj                :: tile indices  C  bi, bj           :: tile indices
42  C  k                    :: vertical level number  C  recip_hFac       :: reciprocal of cell open-depth factor (@ next iter)
43  C  xA                   :: face area at U points in level k  C  uFld, vFld, wFld :: Local copy of velocity field (3 components)
44  C  yA                   :: face area at V points in level k  C  KappaRk          :: vertical diffusion used for one passive tracer
45  C  uTrans               :: zonal transport in level k  C  myTime           :: model time
46  C  vTrans               :: meridional transport in level k  C  myIter           :: time-step number
47  C  rTrans               :: vertical transport across level k  C  myThid           :: thread number
48  C  maskUp               :: mask for vertical transport        INTEGER bi, bj
49  C  KappaRtr             :: vertical diffusion of passive tracers        _RS recip_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
50  C            NOTE!         This is infact KappaRS from thermodynamics()        _RL uFld      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
51  C                          and is being used only temporarily        _RL vFld      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
52  C                          until we removed the need to store        _RL wFld      (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
53  C                          a "3D" diffusivity        _RL KappaRk   (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
 C  myIter               :: time-step number  
 C  myTime               :: model time  
 C  myThid               :: thread number  
       INTEGER bi,bj,k  
       _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS yA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
       _RL KappaRtr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)  
       INTEGER myIter  
54        _RL myTime        _RL myTime
55          INTEGER myIter
56        INTEGER myThid        INTEGER myThid
57    
58  C !OUTPUT PARAMETERS: ==================================================  C !OUTPUT PARAMETERS: ==================================================
# Line 65  C  none Line 61  C  none
61  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
62    
63  C !LOCAL VARIABLES: ====================================================  C !LOCAL VARIABLES: ====================================================
64  C  i,j,k,bi,bj,iTracer  :: loop indices  C  iTracer          :: tracer index
65  C  iMin,iMax,jMin,jMax  :: loop ranges  C  iMin, iMax       :: 1rst index loop range
66  C  kUp,kDown            :: toggle indices for even/odd level fluxes  C  jMin, jMax       :: 2nd  index loop range
67  C  km1                  :: =min(1,k-1)  C  k                :: vertical level number
68  C  rFlx                 :: vertical flux  C  kUp,kDown        :: toggle indices for even/odd level fluxes
69        INTEGER i,j,iTracer  C  kM1              :: =min(1,k-1)
70    C  GAD_TR           :: passive tracer id (GAD_TR1+iTracer-1)
71    C  xA               :: face area at U points in level k
72    C  yA               :: face area at V points in level k
73    C  maskUp           :: mask for vertical transport
74    C  uTrans           :: zonal transport in level k
75    C  vTrans           :: meridional transport in level k
76    C  rTrans           :: vertical volume transport at interface k
77    C  rTransKp         :: vertical volume transport at interface k+1
78    C  fZon             :: passive tracer zonal flux
79    C  fMer             :: passive tracer meridional flux
80    C  fVer             :: passive tracer vertical flux
81          INTEGER iTracer
82        INTEGER iMin,iMax,jMin,jMax        INTEGER iMin,iMax,jMin,jMax
83        INTEGER kUp,kDown,km1        INTEGER i, j, k
84        _RL rFlx(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2,PTRACERS_num)        INTEGER kUp, kDown, kM1
85          INTEGER GAD_TR
86          _RS xA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
87          _RS yA      (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
88          _RS maskUp  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89          _RL uTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90          _RL vTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
91          _RL rTrans  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
92          _RL rTransKp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93          _RL fZon    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
94          _RL fMer    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
95          _RL fVer    (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
96          _RL gTr_AB  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97        LOGICAL calcAdvection        LOGICAL calcAdvection
98          INTEGER iterNb
99          _RL dummy(Nr)
100    #ifdef ALLOW_DIAGNOSTICS
101          CHARACTER*8 diagName
102          CHARACTER*4 diagSufx
103    C-    Functions:
104          CHARACTER*4 GAD_DIAG_SUFX
105          EXTERNAL    GAD_DIAG_SUFX
106    #endif /* ALLOW_DIAGNOSTICS */
107  CEOP  CEOP
108    
109  C Loop over tracers  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
110    
111    C-    Compute iter at beginning of ptracer time step
112    #ifdef ALLOW_LONGSTEP
113          iterNb = myIter - LS_nIter + 1
114          IF (LS_whenToSample.GE.2) iterNb = myIter - LS_nIter
115    #else
116          iterNb = myIter
117          IF (staggerTimeStep) iterNb = myIter - 1
118    #endif
119    
120    C--   Loop over tracers
121        DO iTracer=1,PTRACERS_numInUse        DO iTracer=1,PTRACERS_numInUse
122    
123  C Initialize vertical flux to zero and set no-flux across k=Nr+1  C-    Initialise tracer tendency to zero
124         IF (k.EQ.Nr) THEN         DO k=1,Nr
125          DO j=1-Oly,sNy+Oly          DO j=1-OLy,sNy+OLy
126           DO i=1-Olx,sNx+Olx           DO i=1-OLx,sNx+OLx
127            rFlx(i,j,1,iTracer)=0.             gPTr(i,j,k,bi,bj,iTracer) = 0. _d 0
           rFlx(i,j,2,iTracer)=0.  
128           ENDDO           ENDDO
129          ENDDO          ENDDO
130         ENDIF         ENDDO
131           IF ( PTRACERS_StepFwd(iTracer) ) THEN
132  C Loop ranges for daughter routines          GAD_TR = GAD_TR1 + iTracer - 1
133         iMin = 1-OLx+2  
134         iMax = sNx+OLx-1  C-    Loop ranges for daughter routines
135         jMin = 1-OLy+2          iMin = 1-OLx+2
136         jMax = sNy+OLy-1          iMax = sNx+OLx-1
137            jMin = 1-OLy+2
138         km1  = MAX(1,k-1)          jMax = sNy+OLy-1
139         kUp  = 1+MOD(k+1,2)  
140         kDown= 1+MOD(k,2)  #ifdef ALLOW_AUTODIFF_TAMC
141              act0 = iTracer - 1
142  C Calculate active tracer tendencies (gPtr) due to internal processes            max0 = PTRACERS_num
143  C (advection, [explicit] diffusion, parameterizations,...)            act1 = bi - myBxLo(myThid)
144         calcAdvection = .NOT.multiDimAdvection            max1 = myBxHi(myThid) - myBxLo(myThid) + 1
145       &      .OR. PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND            act2 = bj - myByLo(myThid)
146       &      .OR. PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD            max2 = myByHi(myThid) - myByLo(myThid) + 1
147       &      .OR. PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH            act3 = myThid - 1
148           CALL GAD_CALC_RHS(            max3 = nTx*nTy
149       I                     bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,            act4 = ikey_dynamics - 1
150       I                     xA,yA,uTrans,vTrans,rTrans,maskUp,            iptrkey = (act0 + 1)
151       I                     PTRACERS_diffKh(iTracer),       &                      + act1*max0
152       I                     PTRACERS_diffK4(iTracer),       &                      + act2*max0*max1
153       I                     KappaRtr,       &                      + act3*max0*max1*max2
154       I                     pTracer(1-Olx,1-Oly,1,1,1,iTracer),       &                      + act4*max0*max1*max2*max3
155       I                     GAD_TR1,  #endif /* ALLOW_AUTODIFF_TAMC */
156       I                     PTRACERS_advScheme(iTracer),calcAdvection,  
157       U                     rFlx(1-Olx,1-Oly,1,iTracer),          DO j=1-OLy,sNy+OLy
158       U                     gPtr(1-Olx,1-Oly,1,1,1,iTracer),           DO i=1-OLx,sNx+OLx
159       I                     myThid )             fVer(i,j,1) = 0. _d 0
160               fVer(i,j,2) = 0. _d 0
161  C External forcing term(s)           ENDDO
162  cswdptr - add--          ENDDO
163  #ifndef PTRACERS_SEPERATE_FORCING  #ifdef ALLOW_AUTODIFF
164  cswdptr - end add ---          DO k=1,Nr
165         IF ( forcing_In_AB )           DO j=1-OLy,sNy+OLy
166       &   CALL PTRACERS_FORCING(            DO i=1-OLx,sNx+OLx
167       I                        bi,bj,k,iTracer,             kappaRk(i,j,k) = 0. _d 0
168       U                        gPtr(1-Olx,1-Oly,1,1,1,iTracer),            ENDDO
169       I                        myIter,myTime,myThid)           ENDDO
170  cswdptr --add---          ENDDO
171  #endif  #endif /* ALLOW_AUTODIFF */
 cswdptr -- end add ---  
172    
173  C If using Adams-Bashforth II, then extrapolate tendancies          CALL CALC_3D_DIFFUSIVITY(
174        IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND       I         bi, bj, iMin,iMax,jMin,jMax,
175       & .OR.PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD       I         GAD_TR,
176       & .OR.PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH ) THEN       I         PTRACERS_useGMRedi(iTracer), PTRACERS_useKPP(iTracer),
177          CALL ADAMS_BASHFORTH2(       O         kappaRk,
178       I                        bi,bj,K,       I         myThid)
179       U                        gPtr(1-Olx,1-Oly,1,1,1,iTracer),  
180       U                        gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),  #ifndef DISABLE_MULTIDIM_ADVECTION
181       I                        myIter,myThid )  #ifdef ALLOW_AUTODIFF_TAMC
182        ENDIF  CADJ STORE pTracer(:,:,:,bi,bj,iTracer)
183    CADJ &      = comlev1_bibj_ptracers, key=iptrkey, byte=isbyte
184  C External forcing term(s)  #endif /* ALLOW_AUTODIFF_TAMC */
185  cswdptr - add--  
186  #ifndef PTRACERS_SEPERATE_FORCING  #ifdef PTRACERS_ALLOW_DYN_STATE
187  cswdptr - end add ---          IF ( PTRACERS_SOM_Advection(iTracer) ) THEN
188         IF ( .NOT.forcing_In_AB )  # ifdef ALLOW_DEBUG
189       &   CALL PTRACERS_FORCING(           IF (debugMode) CALL DEBUG_CALL('GAD_SOM_ADVECT',myThid)
190       I                        bi,bj,k,iTracer,  # endif
191       U                        gPtr(1-Olx,1-Oly,1,1,1,iTracer),            CALL GAD_SOM_ADVECT(
192       I                        myIter,myTime,myThid)       I                       PTRACERS_ImplVertAdv(iTracer),
193  cswdptr - add--       I                       PTRACERS_advScheme(iTracer),
194  #endif       I                       PTRACERS_advScheme(iTracer),
195  cswdptr -- end add ---       I                       GAD_TR1+iTracer-1,
196         I                       PTRACERS_dTLev,
197         I                       uFld, vFld, wFld,
198         I                       pTracer(1-OLx,1-OLy,1,1,1,iTracer),
199         U                       _Ptracers_som(:,:,:,:,:,:,iTracer),
200         O                       gPtr(1-OLx,1-OLy,1,1,1,iTracer),
201         I                       bi, bj, myTime, myIter, myThid )
202            ELSEIF ( PTRACERS_MultiDimAdv(iTracer) ) THEN
203    #else /* PTRACERS_ALLOW_DYN_STATE */
204            IF ( PTRACERS_MultiDimAdv(iTracer) ) THEN
205    #endif /* PTRACERS_ALLOW_DYN_STATE */
206    # ifdef ALLOW_DEBUG
207              IF (debugMode) CALL DEBUG_CALL('GAD_ADVECTION',myThid)
208    # endif
209              CALL GAD_ADVECTION(
210         I                        PTRACERS_ImplVertAdv(iTracer),
211         I                        PTRACERS_advScheme(iTracer),
212         I                        PTRACERS_advScheme(iTracer),
213         I                        GAD_TR1+iTracer-1,
214         I                        PTRACERS_dTLev,
215         I                        uFld, vFld, wFld,
216         I                        pTracer(1-OLx,1-OLy,1,1,1,iTracer),
217         O                        gPtr(1-OLx,1-OLy,1,1,1,iTracer),
218         I                        bi, bj, myTime, myIter, myThid )
219            ENDIF
220    #endif /* DISABLE_MULTIDIM_ADVECTION */
221    
222    C-    Start vertical index (k) loop (Nr:1)
223            calcAdvection = .NOT.PTRACERS_MultiDimAdv(iTracer)
224            DO k=Nr,1,-1
225    #ifdef ALLOW_AUTODIFF_TAMC
226              kkey = (iptrkey-1)*Nr + k
227    #endif /* ALLOW_AUTODIFF_TAMC */
228    
229              kM1  = MAX(1,k-1)
230              kUp  = 1+MOD(k+1,2)
231              kDown= 1+MOD(k,2)
232    
233    #ifdef ALLOW_AUTODIFF_TAMC
234    CADJ STORE fVer(:,:,:) = comlev1_bibj_k_ptracers,
235    CADJ &     key = kkey, byte = isbyte, kind = isbyte
236    CADJ STORE gPtr(:,:,k,bi,bj,iTracer) = comlev1_bibj_k_ptracers,
237    CADJ &     key = kkey, byte = isbyte, kind = isbyte
238    CADJ STORE gpTrNm1(:,:,k,bi,bj,iTracer) = comlev1_bibj_k_ptracers,
239    CADJ &     key = kkey, byte = isbyte, kind = isbyte
240    #endif /* ALLOW_AUTODIFF_TAMC */
241              CALL CALC_ADV_FLOW(
242         I                uFld, vFld, wFld,
243         U                rTrans,
244         O                uTrans, vTrans, rTransKp,
245         O                maskUp, xA, yA,
246         I                k, bi, bj, myThid )
247    
248    C-    Calculate active tracer tendencies (gPtr) due to internal processes
249    C      (advection, [explicit] diffusion, parameterizations,...)
250              CALL GAD_CALC_RHS(
251         I             bi,bj, iMin,iMax,jMin,jMax, k,kM1, kUp,kDown,
252         I             xA, yA, maskUp, uFld(1-OLx,1-OLy,k),
253         I             vFld(1-OLx,1-OLy,k), wFld(1-OLx,1-OLy,k),
254         I             uTrans, vTrans, rTrans, rTransKp,
255         I             PTRACERS_diffKh(iTracer),
256         I             PTRACERS_diffK4(iTracer),
257         I             KappaRk(1-OLx,1-OLy,k), dummy,
258         I             gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
259         I             pTracer(1-OLx,1-OLy,1,1,1,iTracer),
260         I             PTRACERS_dTLev, GAD_TR,
261         I             PTRACERS_advScheme(iTracer),
262         I             PTRACERS_advScheme(iTracer),
263         I             calcAdvection, PTRACERS_ImplVertAdv(iTracer),
264         I             .FALSE., .FALSE.,
265         I             PTRACERS_useGMRedi(iTracer),
266         I             PTRACERS_useKPP(iTracer),
267         O             fZon, fMer,
268         U             fVer, gPtr(1-OLx,1-OLy,1,1,1,iTracer),
269         I             myTime, myIter, myThid )
270    
271    C-    External forcing term(s)
272              IF ( tracForcingOutAB.NE.1 )
273         &      CALL PTRACERS_FORCING(
274         I                    bi,bj,iMin,iMax,jMin,jMax,k,iTracer,
275         U                    gPtr(1-OLx,1-OLy,1,1,1,iTracer),
276         I                    surfaceForcingPTr(1-OLx,1-OLy,1,1,iTracer),
277         I                    myIter, myTime, myThid )
278    
279    C-    If using Adams-Bashforth II, then extrapolate tendencies
280    C     gPtr is now the tracer tendency for explicit advection/diffusion
281    
282    C     If matrix is being computed, skip call to S/R ADAMS_BASHFORTH2 to
283    C     prevent gPtr from being replaced by the average of gPtr and gpTrNm1.
284              IF ( .NOT.useMATRIX .AND.
285         &         PTRACERS_AdamsBashGtr(iTracer) ) THEN
286    
287               CALL ADAMS_BASHFORTH2(
288         I                      bi, bj, k, Nr,
289         U                      gPtr(1-OLx,1-OLy,1,1,1,iTracer),
290         U                      gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
291         U                      gTr_AB,
292         I                      PTRACERS_startAB(iTracer), iterNb, myThid )
293    #ifdef ALLOW_DIAGNOSTICS
294               IF ( useDiagnostics ) THEN
295                 diagSufx = GAD_DIAG_SUFX( GAD_TR, myThid )
296                 diagName = 'AB_g'//diagSufx
297                 CALL DIAGNOSTICS_FILL(gTr_AB,diagName,k,1,2,bi,bj,myThid)
298               ENDIF
299    #endif /* ALLOW_DIAGNOSTICS */
300              ENDIF
301    
302    C-    External forcing term(s)
303              IF ( tracForcingOutAB.EQ.1 )
304         &      CALL PTRACERS_FORCING(
305         I                    bi,bj,iMin,iMax,jMin,jMax,k,iTracer,
306         U                    gPtr(1-OLx,1-OLy,1,1,1,iTracer),
307         I                    surfaceForcingPTr(1-OLx,1-OLy,1,1,iTracer),
308         I                    myIter, myTime, myThid )
309    
310  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
311  C Account for change in level thickness  C-    Account for change in level thickness
312        IF (nonlinFreeSurf.GT.0) THEN            IF (nonlinFreeSurf.GT.0) THEN
313          CALL FREESURF_RESCALE_G(             CALL FREESURF_RESCALE_G(
314       I                          bi,bj,K,       I                             bi,bj,k,
315       U                          gPtr(1-Olx,1-Oly,1,1,1,iTracer),       U                             gPtr(1-OLx,1-OLy,1,1,1,iTracer),
316       I                          myThid )       I                             myThid )
317          IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND             IF ( PTRACERS_AdamsBashGtr(iTracer) )
318       &   .OR.PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD       &     CALL FREESURF_RESCALE_G(
319       &   .OR.PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH )       I                             bi,bj,k,
320       &  CALL FREESURF_RESCALE_G(       U                             gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
321       I                          bi,bj,K,       I                             myThid )
322       U                          gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer),            ENDIF
      I                          myThid )  
       ENDIF  
323  #endif /* NONLIN_FRSURF */  #endif /* NONLIN_FRSURF */
324    
325  C Integrate forward in time, storing in gPtr:  G=T+dt*G  C-    Integrate forward in time, storing in gPtr:  G=T+dt*G
326           CALL TIMESTEP_TRACER(            CALL TIMESTEP_TRACER(
327       I                        bi,bj,iMin,iMax,jMin,jMax,k,       I                         bi, bj, k, PTRACERS_dTLev(k),
328       I                        PTRACERS_advScheme(iTracer),       I                         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
329       I                        pTracer(1-Olx,1-Oly,1,1,1,iTracer),       U                         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
330       I                        gPtr(1-Olx,1-Oly,1,1,1,iTracer),       I                         myIter, myThid )
      I                        myIter,myThid )  
331    
332  C end of tracer loop  C-    end of vertical index (k) loop (Nr:1)
333            ENDDO
334    
335    #ifdef ALLOW_DOWN_SLOPE
336            IF ( PTRACERS_useDWNSLP(iTracer) ) THEN
337              IF ( usingPCoords ) THEN
338                CALL DWNSLP_APPLY(
339         I                  GAD_TR, bi, bj, kSurfC,
340         I                  recip_drF, recip_hFacC, recip_rA,
341         I                  PTRACERS_dTLev,
342         I                  pTracer(1-OLx,1-OLy,1,1,1,iTracer),
343         O                  gPtr(1-OLx,1-OLy,1,1,1,iTracer),
344         I                  myTime, myIter, myThid )
345              ELSE
346                CALL DWNSLP_APPLY(
347         I                  GAD_TR, bi, bj, kLowC,
348         I                  recip_drF, recip_hFacC, recip_rA,
349         I                  PTRACERS_dTLev,
350         I                  pTracer(1-OLx,1-OLy,1,1,1,iTracer),
351         O                  gPtr(1-OLx,1-OLy,1,1,1,iTracer),
352         I                  myTime, myIter, myThid )
353              ENDIF
354            ENDIF
355    #endif /* ALLOW_DOWN_SLOPE */
356    
357    C       All explicit advection/diffusion/sources should now be
358    C       done. The updated tracer field is in gPtr.
359    #ifdef ALLOW_MATRIX
360    C       Accumalate explicit tendency and also reset gPtr to initial
361    C       tracer field for implicit matrix calculation
362            IF ( useMATRIX ) CALL MATRIX_STORE_TENDENCY_EXP(
363         I                               iTracer, bi, bj,
364         I                               myTime, myIter, myThid )
365    #endif /* ALLOW_MATRIX */
366    
367    C--     Vertical advection & diffusion (implicit) for passive tracers
368            iMin = 0
369            iMax = sNx+1
370            jMin = 0
371            jMax = sNy+1
372    
373    #ifdef ALLOW_AUTODIFF_TAMC
374    CADJ STORE gPtr(:,:,:,bi,bj,iTracer) = comlev1_bibj_ptracers,
375    CADJ &     key=iptrkey, byte=isbyte
376    #endif /* ALLOW_AUTODIFF_TAMC */
377    
378    #ifdef INCLUDE_IMPLVERTADV_CODE
379            IF ( PTRACERS_ImplVertAdv(iTracer) ) THEN
380              CALL GAD_IMPLICIT_R(
381         I         PTRACERS_ImplVertAdv(iTracer),
382         I         PTRACERS_advScheme(iTracer), GAD_TR,
383         I         PTRACERS_dTLev, kappaRk, recip_hFac, wFld,
384         I         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
385         U         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
386         I         bi, bj, myTime, myIter, myThid )
387    
388            ELSEIF ( implicitDiffusion ) THEN
389    #else /* INCLUDE_IMPLVERTADV_CODE */
390            IF ( implicitDiffusion ) THEN
391    #endif /* INCLUDE_IMPLVERTADV_CODE */
392              CALL IMPLDIFF(
393         I         bi, bj, iMin, iMax, jMin, jMax,
394         I         GAD_TR, kappaRk, recip_hFac,
395         U         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
396         I         myThid )
397            ENDIF
398    
399    #ifdef ALLOW_OBCS
400    C--     Apply open boundary conditions for each passive tracer
401            IF ( useOBCS ) THEN
402              CALL OBCS_APPLY_PTRACER(
403         I         bi, bj, 0, iTracer,
404         U         gPtr(1-OLx,1-OLy,1,bi,bj,iTracer),
405         I         myThid )
406            ENDIF
407    #endif /* ALLOW_OBCS */
408    
409    C--   end of tracer loop
410           ENDIF
411        ENDDO        ENDDO
412    
413  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.52
  ViewVC Help
Powered by ViewVC 1.1.22