/[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.44 - (hide annotations) (download)
Mon Nov 7 20:23:04 2011 UTC (12 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63f, checkpoint63g
Changes since 1.43: +27 -12 lines
- additional output argument for ADAMS_BASHFORTH2 S/R ;
- add diagnostics for Adams-Bashforth tendency increment.

1 jmc 1.44 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_integrate.F,v 1.43 2011/05/23 00:34:36 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.36 #include "PTRACERS_RESTART.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.19 _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    
114 heimbach 1.31 #ifdef ALLOW_AUTODIFF_TAMC
115     act0 = iTracer - 1
116     max0 = PTRACERS_num
117     act1 = bi - myBxLo(myThid)
118     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
119     act2 = bj - myByLo(myThid)
120     max2 = myByHi(myThid) - myByLo(myThid) + 1
121     act3 = myThid - 1
122     max3 = nTx*nTy
123     act4 = ikey_dynamics - 1
124     iptrkey = (act0 + 1)
125     & + act1*max0
126     & + act2*max0*max1
127     & + act3*max0*max1*max2
128     & + act4*max0*max1*max2*max3
129     kkey = (iptrkey-1)*Nr + k
130     #endif /* ALLOW_AUTODIFF_TAMC */
131    
132     #ifdef ALLOW_AUTODIFF_TAMC
133 jmc 1.44 rFlx(1,1,kDown,iTracer) = rFlx(1,1,kDown,iTracer)
134 heimbach 1.31 c
135 jmc 1.35 CADJ STORE pTracer(:,:,k,bi,bj,iTracer)
136 heimbach 1.31 CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
137 jmc 1.35 CADJ STORE gpTrNm1(:,:,k,bi,bj,iTracer)
138 heimbach 1.31 CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
139 heimbach 1.41 # ifdef NONLIN_FRSURF
140     CADJ STORE gpTr(:,:,k,bi,bj,iTracer)
141     CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
142 heimbach 1.42 CADJ STORE rFlx(:,:,:,iTracer)
143 heimbach 1.41 CADJ & = comlev1_bibj_k_ptracers, key=kkey, byte=isbyte
144     # endif
145 heimbach 1.31 #endif /* ALLOW_AUTODIFF_TAMC */
146 jmc 1.32
147 adcroft 1.1 C Calculate active tracer tendencies (gPtr) due to internal processes
148     C (advection, [explicit] diffusion, parameterizations,...)
149 jmc 1.36 calcAdvection = .NOT.PTRACERS_MultiDimAdv(iTracer)
150 dimitri 1.8 GAD_TR = GAD_TR1 + iTracer - 1
151 jmc 1.13 CALL GAD_CALC_RHS(
152 jmc 1.36 I bi,bj,iMin,iMax,jMin,jMax,k,km1,kUp,kDown,
153 jmc 1.32 I xA, yA, maskUp, uFld, vFld, wFld,
154     I uTrans, vTrans, rTrans, rTransKp1,
155 jmc 1.13 I PTRACERS_diffKh(iTracer),
156     I PTRACERS_diffK4(iTracer),
157 jmc 1.19 I KappaRtr(1-Olx,1-Oly,iTracer),
158 jmc 1.35 I gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
159 jmc 1.26 I pTracer(1-Olx,1-Oly,1,1,1,iTracer),
160 jahn 1.38 I PTRACERS_dTLev, GAD_TR,
161 jmc 1.13 I PTRACERS_advScheme(iTracer),
162 jmc 1.14 I PTRACERS_advScheme(iTracer),
163 jmc 1.22 I calcAdvection, PTRACERS_ImplVertAdv(iTracer),
164 jmc 1.29 I .FALSE.,
165 jmc 1.33 I PTRACERS_useGMRedi(iTracer),
166     I PTRACERS_useKPP(iTracer),
167 jmc 1.13 U rFlx(1-Olx,1-Oly,1,iTracer),
168     U gPtr(1-Olx,1-Oly,1,1,1,iTracer),
169 jmc 1.17 I myTime, myIter, myThid )
170 adcroft 1.1
171     C External forcing term(s)
172 jmc 1.30 IF ( tracForcingOutAB.NE.1 )
173 jmc 1.3 & CALL PTRACERS_FORCING(
174 mlosch 1.21 I bi,bj,iMin,iMax,jMin,jMax,k,iTracer,
175 heimbach 1.11 U gPtr(1-Olx,1-Oly,1,1,1,iTracer),
176 jmc 1.35 I surfaceForcingPTr(1-Olx,1-Oly,1,1,iTracer),
177 heimbach 1.11 I myIter,myTime,myThid)
178 adcroft 1.1
179 jmc 1.27 C If using Adams-Bashforth II, then extrapolate tendencies
180 spk 1.24 C gPtr is now the tracer tendency for explicit advection/diffusion
181     #ifdef ALLOW_MATRIX
182 jmc 1.44 C If matrix is being computed, skip call to S/R ADAMS_BASHFORTH2 to
183 jmc 1.35 C prevent gPtr from being replaced by the average of gPtr and gpTrNm1.
184 jmc 1.44 IF ( .NOT.useMATRIX .AND.
185     & PTRACERS_AdamsBashGtr(iTracer) ) THEN
186     #else /* ALLOW_MATRIX */
187     IF ( PTRACERS_AdamsBashGtr(iTracer) ) THEN
188     #endif /* ALLOW_MATRIX */
189 jahn 1.38 C compute iter at beginning of ptracer time step
190     #ifdef ALLOW_LONGSTEP
191     iterNb = myIter - LS_nIter + 1
192 jahn 1.39 IF (LS_whenToSample.GE.2) iterNb = myIter - LS_nIter
193 jahn 1.38 #else
194 jmc 1.23 iterNb = myIter
195     IF (staggerTimeStep) iterNb = myIter - 1
196 jahn 1.38 #endif
197 adcroft 1.1 CALL ADAMS_BASHFORTH2(
198 jmc 1.44 I bi,bj,k,
199 jmc 1.36 U gPtr(1-Olx,1-Oly,1,1,1,iTracer),
200     U gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
201 jmc 1.44 U gTr_AB,
202 jmc 1.36 I PTRACERS_startAB(iTracer), iterNb, myThid )
203 jmc 1.44 #ifdef ALLOW_DIAGNOSTICS
204     IF ( useDiagnostics ) THEN
205     diagSufx = GAD_DIAG_SUFX( GAD_TR, myThid )
206     diagName = 'AB_g'//diagSufx
207     CALL DIAGNOSTICS_FILL(gTr_AB,diagName,k,1,2,bi,bj,myThid)
208 spk 1.24 ENDIF
209 jmc 1.44 #endif /* ALLOW_DIAGNOSTICS */
210     ENDIF
211 jmc 1.3
212     C External forcing term(s)
213 jmc 1.30 IF ( tracForcingOutAB.EQ.1 )
214 jmc 1.3 & CALL PTRACERS_FORCING(
215 mlosch 1.21 I bi,bj,iMin,iMax,jMin,jMax,k,iTracer,
216 heimbach 1.11 U gPtr(1-Olx,1-Oly,1,1,1,iTracer),
217 jmc 1.35 I surfaceForcingPTr(1-Olx,1-Oly,1,1,iTracer),
218 heimbach 1.11 I myIter,myTime,myThid)
219 adcroft 1.1
220     #ifdef NONLIN_FRSURF
221     C Account for change in level thickness
222     IF (nonlinFreeSurf.GT.0) THEN
223     CALL FREESURF_RESCALE_G(
224 jmc 1.44 I bi,bj,k,
225 adcroft 1.1 U gPtr(1-Olx,1-Oly,1,1,1,iTracer),
226 jmc 1.4 I myThid )
227 jmc 1.37 IF ( PTRACERS_AdamsBashGtr(iTracer) )
228 jmc 1.4 & CALL FREESURF_RESCALE_G(
229 jmc 1.44 I bi,bj,k,
230 jmc 1.35 U gpTrNm1(1-Olx,1-Oly,1,1,1,iTracer),
231 adcroft 1.1 I myThid )
232     ENDIF
233     #endif /* NONLIN_FRSURF */
234    
235     C Integrate forward in time, storing in gPtr: G=T+dt*G
236     CALL TIMESTEP_TRACER(
237 jmc 1.43 I bi, bj, k, PTRACERS_dTLev(k),
238 adcroft 1.1 I pTracer(1-Olx,1-Oly,1,1,1,iTracer),
239 jmc 1.43 U gPtr(1-Olx,1-Oly,1,1,1,iTracer),
240     I myIter, myThid )
241 adcroft 1.1
242     C end of tracer loop
243     ENDDO
244    
245     #endif /* ALLOW_PTRACERS */
246    
247     RETURN
248     END

  ViewVC Help
Powered by ViewVC 1.1.22