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

Annotation of /MITgcm/model/src/calc_gt.F

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


Revision 1.61 - (hide annotations) (download)
Tue Nov 19 17:05:40 2013 UTC (10 years, 6 months ago) by jmc
Branch: MAIN
CVS Tags: HEAD
Changes since 1.60: +1 -1 lines
FILE REMOVED
remove routine which are no longer used (after removing k-loop from
 thermodynamics.F) and update ad_diff list

1 jmc 1.61 C $Header: /u/gcmpack/MITgcm/model/src/calc_gt.F,v 1.60 2013/02/19 13:42:19 jmc Exp $
2 adcroft 1.35 C $Name: $
3 cnh 1.1
4 jmc 1.43 #include "PACKAGES_CONFIG.h"
5 cnh 1.19 #include "CPP_OPTIONS.h"
6 cnh 1.1
7 cnh 1.36 CBOP
8     C !ROUTINE: CALC_GT
9     C !INTERFACE:
10 jmc 1.51 SUBROUTINE CALC_GT(
11 cnh 1.1 I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
12 jmc 1.51 I xA, yA, maskUp, uFld, vFld, wFld,
13     I uTrans, vTrans, rTrans, rTransKp1,
14 adcroft 1.25 I KappaRT,
15 adcroft 1.28 U fVerT,
16 adcroft 1.35 I myTime,myIter,myThid )
17 cnh 1.36 C !DESCRIPTION: \bv
18     C *==========================================================*
19 jmc 1.51 C | SUBROUTINE CALC_GT
20     C | o Calculate the temperature tendency terms.
21 cnh 1.36 C *==========================================================*
22 jmc 1.51 C | A procedure called EXTERNAL_FORCING_T is called from
23     C | here. These procedures can be used to add per problem
24     C | heat flux source terms.
25     C | Note: Although it is slightly counter-intuitive the
26     C | EXTERNAL_FORCING routine is not the place to put
27     C | file I/O. Instead files that are required to
28     C | calculate the external source terms are generally
29     C | read during the model main loop. This makes the
30     C | logisitics of multi-processing simpler and also
31     C | makes the adjoint generation simpler. It also
32     C | allows for I/O to overlap computation where that
33     C | is supported by hardware.
34     C | Aside from the problem specific term the code here
35     C | forms the tendency terms due to advection and mixing
36     C | The baseline implementation here uses a centered
37     C | difference form for the advection term and a tensorial
38     C | divergence of a flux form for the diffusive term. The
39     C | diffusive term is formulated so that isopycnal mixing and
40     C | GM-style subgrid-scale terms can be incorporated b simply
41     C | setting the diffusion tensor terms appropriately.
42 cnh 1.36 C *==========================================================*
43     C \ev
44    
45     C !USES:
46 cnh 1.1 IMPLICIT NONE
47     C == GLobal variables ==
48     #include "SIZE.h"
49     #include "DYNVARS.h"
50     #include "EEPARAMS.h"
51     #include "PARAMS.h"
52 jmc 1.53 #include "RESTART.h"
53 jmc 1.43 #ifdef ALLOW_GENERIC_ADVDIFF
54 adcroft 1.34 #include "GAD.h"
55 jmc 1.43 #endif
56 heimbach 1.46 #ifdef ALLOW_AUTODIFF_TAMC
57     # include "tamc.h"
58     # include "tamc_keys.h"
59     #endif
60 cnh 1.1
61 cnh 1.36 C !INPUT/OUTPUT PARAMETERS:
62 cnh 1.1 C == Routine arguments ==
63 jmc 1.51 C bi, bj, :: tile indices
64     C iMin,iMax :: loop range for called routines
65     C jMin,jMax :: loop range for called routines
66     C k :: vertical index
67     C kM1 :: =k-1 for k>1, =1 for k=1
68     C kUp :: index into 2 1/2D array, toggles between 1|2
69     C kDown :: index into 2 1/2D array, toggles between 2|1
70     C xA :: Tracer cell face area normal to X
71     C yA :: Tracer cell face area normal to X
72     C maskUp :: Land mask used to denote base of the domain.
73     C uFld,vFld :: Local copy of horizontal velocity field
74     C wFld :: Local copy of vertical velocity field
75     C uTrans :: Zonal volume transport through cell face
76     C vTrans :: Meridional volume transport through cell face
77     C rTrans :: Vertical volume transport at interface k
78 jmc 1.39 C rTransKp1 :: Vertical volume transport at inteface k+1
79 jmc 1.51 C KappaRT :: Vertical diffusion for Tempertature
80     C fVerT :: Flux of temperature (T) in the vertical direction
81     C at the upper(U) and lower(D) faces of a cell.
82     C myTime :: current time
83     C myIter :: current iteration number
84     C myThid :: my Thread Id. number
85     INTEGER bi,bj,iMin,iMax,jMin,jMax
86     INTEGER k,kUp,kDown,kM1
87     _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
88     _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89     _RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90     _RL uFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
91     _RL vFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
92     _RL wFld (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93     _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
94     _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
95     _RL rTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
96 jmc 1.39 _RL rTransKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97 jmc 1.42 _RL KappaRT(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
98 jmc 1.51 _RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
99 adcroft 1.35 _RL myTime
100     INTEGER myIter
101 cnh 1.1 INTEGER myThid
102 cnh 1.36 CEOP
103 heimbach 1.24
104 jmc 1.43 #ifdef ALLOW_GENERIC_ADVDIFF
105 jmc 1.57 C !LOCAL VARIABLES:
106 jmc 1.37 LOGICAL calcAdvection
107 jmc 1.44 INTEGER iterNb
108 jmc 1.57 _RL gt_AB(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
109 jmc 1.45 #ifdef ALLOW_ADAMSBASHFORTH_3
110     INTEGER m1, m2
111     #endif
112 jmc 1.37
113 heimbach 1.24 #ifdef ALLOW_AUTODIFF_TAMC
114 heimbach 1.46 act1 = bi - myBxLo(myThid)
115     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
116     act2 = bj - myByLo(myThid)
117     max2 = myByHi(myThid) - myByLo(myThid) + 1
118     act3 = myThid - 1
119     max3 = nTx*nTy
120     act4 = ikey_dynamics - 1
121     itdkey = (act1 + 1) + act2*max1
122     & + act3*max1*max2
123     & + act4*max1*max2*max3
124     kkey = (itdkey-1)*Nr + k
125     #endif /* ALLOW_AUTODIFF_TAMC */
126    
127     #ifdef ALLOW_AUTODIFF_TAMC
128 heimbach 1.24 C-- only the kUp part of fverT is set in this subroutine
129     C-- the kDown is still required
130     fVerT(1,1,kDown) = fVerT(1,1,kDown)
131 heimbach 1.46 # ifdef NONLIN_FRSURF
132 heimbach 1.49 CADJ STORE fVerT(:,:,:) =
133 heimbach 1.54 CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
134     CADJ & kind = isbyte
135 heimbach 1.56 # ifndef ALLOW_ADAMSBASHFORTH_3
136 jmc 1.53 CADJ STORE gtNm1(:,:,k,bi,bj) =
137 heimbach 1.54 CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
138     CADJ & kind = isbyte
139 heimbach 1.56 # else
140     CADJ STORE gt(:,:,k,bi,bj) =
141     CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
142     CADJ & kind = isbyte
143     CADJ STORE gtNm(:,:,k,bi,bj,1) =
144     CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
145     CADJ & kind = isbyte
146     CADJ STORE gtNm(:,:,k,bi,bj,2) =
147     CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
148     CADJ & kind = isbyte
149     # endif
150 heimbach 1.46 # endif
151 adcroft 1.20 #endif
152 cnh 1.1
153 jmc 1.45 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
154    
155 jmc 1.37 calcAdvection = tempAdvection .AND. .NOT.tempMultiDimAdvec
156 jmc 1.45 iterNb = myIter
157     IF (staggerTimeStep) iterNb = myIter -1
158    
159     #ifdef ALLOW_ADAMSBASHFORTH_3
160     m1 = 1 + MOD(iterNb+1,2)
161     m2 = 1 + MOD( iterNb ,2)
162     CALL GAD_CALC_RHS(
163     I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
164 jmc 1.51 I xA, yA, maskUp, uFld, vFld, wFld,
165     I uTrans, vTrans, rTrans, rTransKp1,
166 jmc 1.59 I diffKhT, diffK4T, KappaRT, diffKr4T,
167 jmc 1.60 I gtNm(1-OLx,1-OLy,1,1,1,m2), theta, dTtracerLev,
168 jmc 1.45 I GAD_TEMPERATURE, tempAdvScheme, tempVertAdvScheme,
169 jmc 1.48 I calcAdvection, tempImplVertAdv, AdamsBashforth_T,
170 jmc 1.59 I tempVertDiff4, useGMRedi, useKPP,
171 jmc 1.45 U fVerT, gT,
172     I myTime, myIter, myThid )
173 jmc 1.47 #else /* ALLOW_ADAMSBASHFORTH_3 */
174     CALL GAD_CALC_RHS(
175     I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
176 jmc 1.51 I xA, yA, maskUp, uFld, vFld, wFld,
177     I uTrans, vTrans, rTrans, rTransKp1,
178 jmc 1.59 I diffKhT, diffK4T, KappaRT, diffKr4T,
179     I gtNm1, theta, dTtracerLev,
180 jmc 1.47 I GAD_TEMPERATURE, tempAdvScheme, tempVertAdvScheme,
181 jmc 1.48 I calcAdvection, tempImplVertAdv, AdamsBashforth_T,
182 jmc 1.59 I tempVertDiff4, useGMRedi, useKPP,
183 jmc 1.47 U fVerT, gT,
184     I myTime, myIter, myThid )
185 jmc 1.45 #endif
186 cnh 1.1
187 jmc 1.37 C-- External thermal forcing term(s) inside Adams-Bashforth:
188 jmc 1.50 IF ( tempForcing .AND. tracForcingOutAB.NE.1 )
189 jmc 1.37 & CALL EXTERNAL_FORCING_T(
190 cnh 1.19 I iMin,iMax,jMin,jMax,bi,bj,k,
191 adcroft 1.35 I myTime,myThid)
192    
193 jmc 1.45 IF ( AdamsBashforthGt ) THEN
194 jmc 1.44 #ifdef ALLOW_ADAMSBASHFORTH_3
195     CALL ADAMS_BASHFORTH3(
196 jmc 1.60 I bi, bj, k, Nr,
197 jmc 1.57 U gT, gtNm, gt_AB,
198 jmc 1.45 I tempStartAB, iterNb, myThid )
199 jmc 1.44 #else
200 adcroft 1.35 CALL ADAMS_BASHFORTH2(
201 jmc 1.60 I bi, bj, k, Nr,
202 jmc 1.57 U gT, gtNm1, gt_AB,
203 jmc 1.53 I tempStartAB, iterNb, myThid )
204 jmc 1.44 #endif
205 jmc 1.57 #ifdef ALLOW_DIAGNOSTICS
206     IF ( useDiagnostics ) THEN
207 jmc 1.58 CALL DIAGNOSTICS_FILL(gt_AB,'AB_gT ',k,1,2,bi,bj,myThid)
208 jmc 1.57 ENDIF
209     #endif /* ALLOW_DIAGNOSTICS */
210 adcroft 1.35 ENDIF
211 jmc 1.37
212     C-- External thermal forcing term(s) outside Adams-Bashforth:
213 jmc 1.50 IF ( tempForcing .AND. tracForcingOutAB.EQ.1 )
214 jmc 1.37 & CALL EXTERNAL_FORCING_T(
215     I iMin,iMax,jMin,jMax,bi,bj,k,
216     I myTime,myThid)
217 adcroft 1.35
218     #ifdef NONLIN_FRSURF
219     IF (nonlinFreeSurf.GT.0) THEN
220     CALL FREESURF_RESCALE_G(
221 jmc 1.44 I bi, bj, k,
222 adcroft 1.35 U gT,
223 jmc 1.38 I myThid )
224 jmc 1.45 IF ( AdamsBashforthGt ) THEN
225 jmc 1.44 #ifdef ALLOW_ADAMSBASHFORTH_3
226 heimbach 1.56 # ifdef ALLOW_AUTODIFF_TAMC
227     CADJ STORE gtNm(:,:,k,bi,bj,1) =
228     CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
229     CADJ & kind = isbyte
230     CADJ STORE gtNm(:,:,k,bi,bj,2) =
231     CADJ & comlev1_bibj_k, key=kkey, byte=isbyte,
232     CADJ & kind = isbyte
233     # endif
234 jmc 1.44 CALL FREESURF_RESCALE_G(
235     I bi, bj, k,
236 jmc 1.60 U gtNm(1-OLx,1-OLy,1,1,1,1),
237 jmc 1.44 I myThid )
238     CALL FREESURF_RESCALE_G(
239     I bi, bj, k,
240 jmc 1.60 U gtNm(1-OLx,1-OLy,1,1,1,2),
241 adcroft 1.35 I myThid )
242 jmc 1.44 #else
243     CALL FREESURF_RESCALE_G(
244     I bi, bj, k,
245     U gtNm1,
246     I myThid )
247     #endif
248     ENDIF
249 adcroft 1.35 ENDIF
250     #endif /* NONLIN_FRSURF */
251 cnh 1.1
252 jmc 1.43 #endif /* ALLOW_GENERIC_ADVDIFF */
253    
254 cnh 1.1 RETURN
255     END

  ViewVC Help
Powered by ViewVC 1.1.22