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

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

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


Revision 1.45 - (hide annotations) (download)
Thu Mar 8 17:08:36 2012 UTC (12 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63k
Changes since 1.44: +20 -18 lines
-rename PTRACERS_RESTART.h --> PTRACERS_START.h
-only step forward tracer if PTRACERS_StepFwd(iTr)=T

1 jmc 1.45 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_integrate.F,v 1.44 2011/11/07 20:23:04 jmc Exp $
2 adcroft 1.2 C $Name: $
3 adcroft 1.1
4     #include "PTRACERS_OPTIONS.h"
5    
6     CBOP
7 heimbach 1.7 C !ROUTINE: PTRACERS_INTEGRATE
8 adcroft 1.1
9     C !INTERFACE: ==========================================================
10 heimbach 1.7 SUBROUTINE PTRACERS_INTEGRATE(
11 jmc 1.32 I bi,bj,k,
12     I xA, yA, maskUp, uFld, vFld, wFld,
13     I uTrans, vTrans, rTrans, rTransKp1,
14     I KappaRtr,
15     U rFlx,
16     I myTime,myIter,myThid )
17 adcroft 1.1
18     C !DESCRIPTION:
19 jmc 1.26 C Calculates tendency for passive tracers and integrates forward
20 adcroft 1.1 C in time.
21    
22     C !USES: ===============================================================
23     IMPLICIT NONE
24     #include "SIZE.h"
25     #include "EEPARAMS.h"
26 adcroft 1.5 #include "PARAMS.h"
27 jmc 1.13 #include "DYNVARS.h"
28 jahn 1.38 #ifdef ALLOW_LONGSTEP
29     #include "LONGSTEP_PARAMS.h"
30     #endif
31 jmc 1.15 #include "PTRACERS_SIZE.h"
32 jmc 1.35 #include "PTRACERS_PARAMS.h"
33 jmc 1.45 #include "PTRACERS_START.h"
34 jmc 1.35 #include "PTRACERS_FIELDS.h"
35 adcroft 1.1 #include "GAD.h"
36 heimbach 1.31 #ifdef ALLOW_AUTODIFF_TAMC
37     # include "tamc.h"
38     # include "tamc_keys.h"
39     #endif
40 adcroft 1.1
41     C !INPUT PARAMETERS: ===================================================
42     C bi,bj :: tile indices
43     C k :: vertical level number
44     C xA :: face area at U points in level k
45     C yA :: face area at V points in level k
46 jmc 1.32 C maskUp :: mask for vertical transport
47     C uFld,vFld,wFld :: Local copy of velocity field (3 components)
48 adcroft 1.1 C uTrans :: zonal transport in level k
49     C vTrans :: meridional transport in level k
50 jmc 1.13 C rTrans :: vertical volume transport at interface k
51     C rTransKp1 :: vertical volume transport at interface k+1
52 jmc 1.36 C KappaRtr :: vertical diffusion of passive tracers, interf k
53     C rFlx :: vertical flux
54 jmc 1.32 C myTime :: model time
55 adcroft 1.1 C myIter :: time-step number
56     C myThid :: thread number
57     INTEGER bi,bj,k
58     _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
59     _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
60 jmc 1.32 _RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61     _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62     _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
63     _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64 adcroft 1.1 _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65     _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66     _RL rTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67 jmc 1.13 _RL rTransKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68 jmc 1.45 _RL KappaRtr(1-OLx:sNx+OLx,1-OLy:sNy+OLy,PTRACERS_num)
69 jmc 1.32 _RL rFlx (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2,PTRACERS_num)
70     _RL myTime
71 adcroft 1.1 INTEGER myIter
72     INTEGER myThid
73    
74     C !OUTPUT PARAMETERS: ==================================================
75     C none
76    
77     #ifdef ALLOW_PTRACERS
78    
79     C !LOCAL VARIABLES: ====================================================
80 jmc 1.27 C iTracer :: tracer index
81 adcroft 1.1 C iMin,iMax,jMin,jMax :: loop ranges
82     C kUp,kDown :: toggle indices for even/odd level fluxes
83     C km1 :: =min(1,k-1)
84 dimitri 1.8 C GAD_TR :: passive tracer id (GAD_TR1+iTracer-1)
85 jmc 1.27 INTEGER iTracer
86 adcroft 1.1 INTEGER iMin,iMax,jMin,jMax
87     INTEGER kUp,kDown,km1
88 dimitri 1.8 INTEGER GAD_TR
89 jmc 1.3 LOGICAL calcAdvection
90 jmc 1.36 INTEGER iterNb
91 jmc 1.44 _RL gTr_AB (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
92     #ifdef ALLOW_DIAGNOSTICS
93     CHARACTER*8 diagName
94     CHARACTER*4 diagSufx
95     C- Functions:
96     CHARACTER*4 GAD_DIAG_SUFX
97     EXTERNAL GAD_DIAG_SUFX
98     #endif /* ALLOW_DIAGNOSTICS */
99 adcroft 1.1 CEOP
100    
101 heimbach 1.31 C Loop ranges for daughter routines
102     iMin = 1-OLx+2
103     iMax = sNx+OLx-1
104     jMin = 1-OLy+2
105     jMax = sNy+OLy-1
106 jmc 1.32
107 heimbach 1.31 km1 = MAX(1,k-1)
108     kUp = 1+MOD(k+1,2)
109     kDown= 1+MOD(k,2)
110    
111 adcroft 1.1 C Loop over tracers
112     DO iTracer=1,PTRACERS_numInUse
113 jmc 1.45 IF ( PTRACERS_StepFwd(iTracer) ) THEN
114 adcroft 1.1
115 heimbach 1.31 #ifdef ALLOW_AUTODIFF_TAMC
116     act0 = iTracer - 1
117     max0 = PTRACERS_num
118     act1 = bi - myBxLo(myThid)
119     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
120     act2 = bj - myByLo(myThid)
121     max2 = myByHi(myThid) - myByLo(myThid) + 1
122     act3 = myThid - 1
123     max3 = nTx*nTy
124     act4 = ikey_dynamics - 1
125     iptrkey = (act0 + 1)
126     & + act1*max0
127     & + act2*max0*max1
128     & + act3*max0*max1*max2
129     & + act4*max0*max1*max2*max3
130     kkey = (iptrkey-1)*Nr + k
131     #endif /* ALLOW_AUTODIFF_TAMC */
132    
133     #ifdef ALLOW_AUTODIFF_TAMC
134 jmc 1.44 rFlx(1,1,kDown,iTracer) = rFlx(1,1,kDown,iTracer)
135 heimbach 1.31 c
136 jmc 1.35 CADJ STORE pTracer(:,:,k,bi,bj,iTracer)
137 heimbach 1.31 CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
138 jmc 1.35 CADJ STORE gpTrNm1(:,:,k,bi,bj,iTracer)
139 heimbach 1.31 CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
140 heimbach 1.41 # ifdef NONLIN_FRSURF
141     CADJ STORE gpTr(:,:,k,bi,bj,iTracer)
142     CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
143 heimbach 1.42 CADJ STORE rFlx(:,:,:,iTracer)
144 heimbach 1.41 CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
145     # endif
146 heimbach 1.31 #endif /* ALLOW_AUTODIFF_TAMC */
147 jmc 1.32
148 adcroft 1.1 C Calculate active tracer tendencies (gPtr) due to internal processes
149     C (advection, [explicit] diffusion, parameterizations,...)
150 jmc 1.36 calcAdvection = .NOT.PTRACERS_MultiDimAdv(iTracer)
151 dimitri 1.8 GAD_TR = GAD_TR1 + iTracer - 1
152 jmc 1.13 CALL GAD_CALC_RHS(
153 jmc 1.36 I bi,bj,iMin,iMax,jMin,jMax,k,km1,kUp,kDown,
154 jmc 1.32 I xA, yA, maskUp, uFld, vFld, wFld,
155     I uTrans, vTrans, rTrans, rTransKp1,
156 jmc 1.13 I PTRACERS_diffKh(iTracer),
157     I PTRACERS_diffK4(iTracer),
158 jmc 1.45 I KappaRtr(1-OLx,1-OLy,iTracer),
159     I gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
160     I pTracer(1-OLx,1-OLy,1,1,1,iTracer),
161 jahn 1.38 I PTRACERS_dTLev, GAD_TR,
162 jmc 1.13 I PTRACERS_advScheme(iTracer),
163 jmc 1.14 I PTRACERS_advScheme(iTracer),
164 jmc 1.22 I calcAdvection, PTRACERS_ImplVertAdv(iTracer),
165 jmc 1.29 I .FALSE.,
166 jmc 1.33 I PTRACERS_useGMRedi(iTracer),
167     I PTRACERS_useKPP(iTracer),
168 jmc 1.45 U rFlx(1-OLx,1-OLy,1,iTracer),
169     U gPtr(1-OLx,1-OLy,1,1,1,iTracer),
170 jmc 1.17 I myTime, myIter, myThid )
171 adcroft 1.1
172     C External forcing term(s)
173 jmc 1.30 IF ( tracForcingOutAB.NE.1 )
174 jmc 1.3 & CALL PTRACERS_FORCING(
175 mlosch 1.21 I bi,bj,iMin,iMax,jMin,jMax,k,iTracer,
176 jmc 1.45 U gPtr(1-OLx,1-OLy,1,1,1,iTracer),
177     I surfaceForcingPTr(1-OLx,1-OLy,1,1,iTracer),
178 heimbach 1.11 I myIter,myTime,myThid)
179 adcroft 1.1
180 jmc 1.27 C If using Adams-Bashforth II, then extrapolate tendencies
181 spk 1.24 C gPtr is now the tracer tendency for explicit advection/diffusion
182     #ifdef ALLOW_MATRIX
183 jmc 1.44 C If matrix is being computed, skip call to S/R ADAMS_BASHFORTH2 to
184 jmc 1.35 C prevent gPtr from being replaced by the average of gPtr and gpTrNm1.
185 jmc 1.44 IF ( .NOT.useMATRIX .AND.
186     & PTRACERS_AdamsBashGtr(iTracer) ) THEN
187     #else /* ALLOW_MATRIX */
188     IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN
189     #endif /* ALLOW_MATRIX */
190 jahn 1.38 C compute iter at beginning of ptracer time step
191     #ifdef ALLOW_LONGSTEP
192     iterNb = myIter - LS_nIter + 1
193 jahn 1.39 IF (LS_whenToSample.GE.2) iterNb = myIter - LS_nIter
194 jahn 1.38 #else
195 jmc 1.23 iterNb = myIter
196     IF (staggerTimeStep) iterNb = myIter - 1
197 jahn 1.38 #endif
198 adcroft 1.1 CALL ADAMS_BASHFORTH2(
199 jmc 1.44 I bi,bj,k,
200 jmc 1.45 U gPtr(1-OLx,1-OLy,1,1,1,iTracer),
201     U gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
202 jmc 1.44 U gTr_AB,
203 jmc 1.36 I PTRACERS_startAB(iTracer), iterNb, myThid )
204 jmc 1.44 #ifdef ALLOW_DIAGNOSTICS
205     IF ( useDiagnostics ) THEN
206     diagSufx = GAD_DIAG_SUFX( GAD_TR, myThid )
207     diagName = 'AB_g'//diagSufx
208     CALL DIAGNOSTICS_FILL(gTr_AB,diagName,k,1,2,bi,bj,myThid)
209 spk 1.24 ENDIF
210 jmc 1.44 #endif /* ALLOW_DIAGNOSTICS */
211     ENDIF
212 jmc 1.3
213     C External forcing term(s)
214 jmc 1.30 IF ( tracForcingOutAB.EQ.1 )
215 jmc 1.3 & CALL PTRACERS_FORCING(
216 mlosch 1.21 I bi,bj,iMin,iMax,jMin,jMax,k,iTracer,
217 jmc 1.45 U gPtr(1-OLx,1-OLy,1,1,1,iTracer),
218     I surfaceForcingPTr(1-OLx,1-OLy,1,1,iTracer),
219 heimbach 1.11 I myIter,myTime,myThid)
220 adcroft 1.1
221     #ifdef NONLIN_FRSURF
222     C Account for change in level thickness
223     IF (nonlinFreeSurf.GT.0) THEN
224     CALL FREESURF_RESCALE_G(
225 jmc 1.44 I bi,bj,k,
226 jmc 1.45 U gPtr(1-OLx,1-OLy,1,1,1,iTracer),
227 jmc 1.4 I myThid )
228 jmc 1.37 IF ( PTRACERS_AdamsBashGtr(iTracer) )
229 jmc 1.4 & CALL FREESURF_RESCALE_G(
230 jmc 1.44 I bi,bj,k,
231 jmc 1.45 U gpTrNm1(1-OLx,1-OLy,1,1,1,iTracer),
232 adcroft 1.1 I myThid )
233     ENDIF
234     #endif /* NONLIN_FRSURF */
235    
236     C Integrate forward in time, storing in gPtr: G=T+dt*G
237     CALL TIMESTEP_TRACER(
238 jmc 1.43 I bi, bj, k, PTRACERS_dTLev(k),
239 jmc 1.45 I pTracer(1-OLx,1-OLy,1,1,1,iTracer),
240     U gPtr(1-OLx,1-OLy,1,1,1,iTracer),
241 jmc 1.43 I myIter, myThid )
242 adcroft 1.1
243     C end of tracer loop
244 jmc 1.45 ENDIF
245 adcroft 1.1 ENDDO
246    
247     #endif /* ALLOW_PTRACERS */
248    
249     RETURN
250     END

  ViewVC Help
Powered by ViewVC 1.1.22