/[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.46 - (hide annotations) (download)
Fri Jun 15 13:30:36 2012 UTC (11 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63o, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64d
Changes since 1.45: +4 -3 lines
change argument list of S/R GAD_CALC_RHS (for vertical biharmonic diffusion)

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

  ViewVC Help
Powered by ViewVC 1.1.22