/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_fill_state.F
ViewVC logotype

Annotation of /MITgcm/pkg/diagnostics/diagnostics_fill_state.F

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


Revision 1.38 - (hide annotations) (download)
Tue May 27 00:08:48 2008 UTC (15 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint62, checkpoint59r, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.37: +13 -7 lines
add diagnostics for cell-center average horiz.velocity
 (and rotated to Eastward & Northward directions)

1 jmc 1.38 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_fill_state.F,v 1.37 2008/04/22 22:01:01 jmc Exp $
2 edhill 1.6 C $Name: $
3    
4 edhill 1.10 #include "DIAG_OPTIONS.h"
5 jmc 1.7
6 jmc 1.15 CBOP
7     C !ROUTINE: DIAGNOSTICS_FILL_STATE
8     C !INTERFACE:
9     SUBROUTINE DIAGNOSTICS_FILL_STATE( selectVars, myThid )
10    
11     C !DESCRIPTION: \bv
12     C *==========================================================*
13     C | SUBROUTINE DIAGNOSTICS_FILL_STATE
14     C | o Fill-in main code, state-variables diagnostics
15     C *==========================================================*
16     C \ev
17    
18     C !USES:
19     IMPLICIT NONE
20     C == Global variables ===
21 molod 1.1 #include "SIZE.h"
22     #include "EEPARAMS.h"
23 molod 1.24 #include "PARAMS.h"
24 molod 1.1 #include "GRID.h"
25 jmc 1.37 #include "SURFACE.h"
26 molod 1.1 #include "DYNVARS.h"
27 jmc 1.37 #include "NH_VARS.h"
28 molod 1.1
29 jmc 1.15 C !INPUT/OUTPUT PARAMETERS:
30     C == Routine arguments ==
31     C selectVars :: select which group of dianostics variables to fill-in
32     C = 1 :: fill-in diagnostics for tracer variables only
33     C = 2 :: fill-in diagnostics for momentum variables only
34     C = 3 :: fill-in diagnostics for momentum & tracer variables
35 molod 1.29 C = 4 :: fill-in state variable tendency diagnostics the second time
36 jmc 1.15 C myThid :: my Thread Id number
37 jmc 1.31 INTEGER selectVars
38     INTEGER myThid
39 jmc 1.7
40     #ifdef ALLOW_DIAGNOSTICS
41 jmc 1.15 C !LOCAL VARIABLES:
42     C == Local variables ==
43 jmc 1.13 LOGICAL DIAGNOSTICS_IS_ON
44     EXTERNAL DIAGNOSTICS_IS_ON
45     _RL tmpMk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
46     _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
47 jmc 1.38 _RL tmpU (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
48     _RL tmpV (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
49 jmc 1.23 _RL tmpFac, uBarC, vBarC
50 jmc 1.25 #ifdef ALLOW_FIZHI
51 molod 1.24 _RL dummy1, dummy2, dummy3, dummy4, kappa, getcon
52 jmc 1.25 #endif
53 jmc 1.13 INTEGER i,j,K,bi,bj
54     INTEGER km1
55 jmc 1.31
56 jmc 1.21 tmpFac = 1. _d 0
57    
58 molod 1.29 IF ( selectVars.EQ.2 .OR. selectVars.EQ.3 ) THEN
59 jmc 1.15 C-- fill momentum state-var diagnostics:
60    
61 jmc 1.21 CALL DIAGNOSTICS_FILL(etaN, 'ETAN ',0, 1,0,1,1,myThid)
62 molod 1.22
63     IF ( DIAGNOSTICS_IS_ON('RSURF ',myThid) ) THEN
64     DO bj = myByLo(myThid), myByHi(myThid)
65     DO bi = myBxLo(myThid), myBxHi(myThid)
66     DO j = 1,sNy
67     DO i = 1,sNx
68     tmp1k(i,j,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
69     ENDDO
70     ENDDO
71     ENDDO
72     ENDDO
73     CALL DIAGNOSTICS_FILL(tmp1k,'RSURF ',0,1,0,1,1,myThid)
74     ENDIF
75    
76 jmc 1.21 CALL DIAGNOSTICS_SCALE_FILL(etaN,tmpFac,2,
77     & 'ETANSQ ',0, 1,0,1,1,myThid)
78 jmc 1.31
79 jmc 1.12 #ifdef EXACT_CONSERV
80 jmc 1.21 CALL DIAGNOSTICS_SCALE_FILL(dEtaHdt,tmpFac,2,
81     & 'DETADT2 ',0, 1,0,1,1,myThid)
82 jmc 1.12 #endif
83 jmc 1.37 #ifdef ALLOW_NONHYDROSTATIC
84     IF ( use3Dsolver ) THEN
85     CALL DIAGNOSTICS_FILL( phi_nh,'PHI_NH ',0,Nr,0,1,1,myThid )
86     ENDIF
87     #endif
88 jmc 1.31
89 jmc 1.15 CALL DIAGNOSTICS_FILL(uVel, 'UVEL ',0,Nr,0,1,1,myThid)
90     CALL DIAGNOSTICS_FILL(vVel, 'VVEL ',0,Nr,0,1,1,myThid)
91     CALL DIAGNOSTICS_FILL(wVel, 'WVEL ',0,Nr,0,1,1,myThid)
92 jmc 1.31
93 jmc 1.21 CALL DIAGNOSTICS_SCALE_FILL(uVel,tmpFac,2,
94     & 'UVELSQ ',0,Nr,0,1,1,myThid)
95     CALL DIAGNOSTICS_SCALE_FILL(vVel,tmpFac,2,
96     & 'VVELSQ ',0,Nr,0,1,1,myThid)
97     CALL DIAGNOSTICS_SCALE_FILL(wVel,tmpFac,2,
98     & 'WVELSQ ',0,Nr,0,1,1,myThid)
99    
100 jmc 1.15 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
101    
102 jmc 1.38 IF ( DIAGNOSTICS_IS_ON('UE_VEL_C',myThid) .OR.
103     & DIAGNOSTICS_IS_ON('VN_VEL_C',myThid) .OR.
104     & DIAGNOSTICS_IS_ON('UV_VEL_C',myThid) ) THEN
105 jmc 1.15 DO bj = myByLo(myThid), myByHi(myThid)
106     DO bi = myBxLo(myThid), myBxHi(myThid)
107     DO K=1,Nr
108     DO j = 1,sNy
109     DO i = 1,sNx
110 jmc 1.23 uBarC = 0.5 _d 0
111 jmc 1.15 & *(uVel(i,j,K,bi,bj)+uVel(i+1,j,K,bi,bj))
112 jmc 1.23 vBarC = 0.5 _d 0
113 jmc 1.15 & *(vVel(i,j,K,bi,bj)+vVel(i,j+1,K,bi,bj))
114 jmc 1.38 tmpU(i,j) = angleCosC(i,j,bi,bj)*uBarC
115     & -angleSinC(i,j,bi,bj)*vBarC
116     tmpV(i,j) = angleSinC(i,j,bi,bj)*uBarC
117     & +angleCosC(i,j,bi,bj)*vBarC
118     tmpMk(i,j,K,bi,bj) = tmpU(i,j)*tmpV(i,j)
119 jmc 1.15 ENDDO
120     ENDDO
121 jmc 1.38 CALL DIAGNOSTICS_FILL(tmpU,'UE_VEL_C',k,1,2,bi,bj,myThid)
122     CALL DIAGNOSTICS_FILL(tmpV,'VN_VEL_C',k,1,2,bi,bj,myThid)
123 jmc 1.15 ENDDO
124     ENDDO
125     ENDDO
126     CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_C',0,Nr,0,1,1,myThid)
127     ENDIF
128 jmc 1.31
129 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('UV_VEL_Z',myThid) ) THEN
130     DO bj = myByLo(myThid), myByHi(myThid)
131     DO bi = myBxLo(myThid), myBxHi(myThid)
132     DO K=1,Nr
133     DO j = 1,sNy+1
134     DO i = 1,sNx+1
135     tmpMk(i,j,K,bi,bj) = 0.25 _d 0
136     & *(uVel(i,j-1,K,bi,bj)+uVel(i,j,K,bi,bj))
137     & *(vVel(i-1,j,K,bi,bj)+vVel(i,j,K,bi,bj))
138     ENDDO
139     ENDDO
140     ENDDO
141     ENDDO
142     ENDDO
143     CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_Z',0,Nr,0,1,1,myThid)
144     ENDIF
145 jmc 1.31
146 jmc 1.16 IF ( DIAGNOSTICS_IS_ON('WU_VEL ',myThid) ) THEN
147     DO bj = myByLo(myThid), myByHi(myThid)
148     DO bi = myBxLo(myThid), myBxHi(myThid)
149     DO K=1,Nr
150     km1 = MAX(k-1,1)
151     DO j = 1,sNy
152     DO i = 1,sNx+1
153     tmpMk(i,j,K,bi,bj) = 0.25 _d 0
154 jmc 1.17 & *(uVel(i,j,km1,bi,bj)+uVel(i,j,K,bi,bj))
155 jmc 1.16 & *(wVel(i-1,j,K,bi,bj)*rA(i-1,j,bi,bj)
156     & +wVel( i ,j,K,bi,bj)*rA( i ,j,bi,bj)
157     & )*recip_rAw(i,j,bi,bj)
158     ENDDO
159     ENDDO
160     ENDDO
161     ENDDO
162     ENDDO
163     CALL DIAGNOSTICS_FILL(tmpMk,'WU_VEL ',0,Nr,0,1,1,myThid)
164     ENDIF
165    
166     IF ( DIAGNOSTICS_IS_ON('WV_VEL ',myThid) ) THEN
167     DO bj = myByLo(myThid), myByHi(myThid)
168     DO bi = myBxLo(myThid), myBxHi(myThid)
169     DO K=1,Nr
170     km1 = MAX(k-1,1)
171     DO j = 1,sNy+1
172     DO i = 1,sNx
173     tmpMk(i,j,K,bi,bj) = 0.25 _d 0
174 jmc 1.17 & *(vVel(i,j,km1,bi,bj)+vVel(i,j,K,bi,bj))
175 jmc 1.16 & *(wVel(i,j-1,K,bi,bj)*rA(i,j-1,bi,bj)
176     & +wVel(i, j ,K,bi,bj)*rA(i, j ,bi,bj)
177     & )*recip_rAs(i,j,bi,bj)
178     ENDDO
179     ENDDO
180     ENDDO
181     ENDDO
182     ENDDO
183     CALL DIAGNOSTICS_FILL(tmpMk,'WV_VEL ',0,Nr,0,1,1,myThid)
184     ENDIF
185    
186 jmc 1.15 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
187    
188     IF ( DIAGNOSTICS_IS_ON('UVELTH ',myThid) ) THEN
189     DO bj = myByLo(myThid), myByHi(myThid)
190     DO bi = myBxLo(myThid), myBxHi(myThid)
191     DO K=1,Nr
192 jmc 1.13 DO j = 1,sNy
193 jmc 1.15 DO i = 1,sNx+1
194     tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
195     & *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))
196     ENDDO
197 jmc 1.13 ENDDO
198 jmc 1.15 ENDDO
199 jmc 1.13 ENDDO
200 jmc 1.15 ENDDO
201     CALL DIAGNOSTICS_FILL(tmpMk,'UVELTH ',0,Nr,0,1,1,myThid)
202     ENDIF
203 jmc 1.31
204 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('VVELTH ',myThid) ) THEN
205     DO bj = myByLo(myThid), myByHi(myThid)
206     DO bi = myBxLo(myThid), myBxHi(myThid)
207     DO K=1,Nr
208     DO j = 1,sNy+1
209     DO i = 1,sNx
210     tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
211     & *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))
212     ENDDO
213 jmc 1.13 ENDDO
214 jmc 1.15 ENDDO
215 jmc 1.13 ENDDO
216 jmc 1.15 ENDDO
217     CALL DIAGNOSTICS_FILL(tmpMk,'VVELTH ',0,Nr,0,1,1,myThid)
218     ENDIF
219 jmc 1.31
220 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('WVELTH ',myThid) ) THEN
221     DO bj = myByLo(myThid), myByHi(myThid)
222     DO bi = myBxLo(myThid), myBxHi(myThid)
223     DO K=1,Nr
224     km1 = MAX(k-1,1)
225 jmc 1.13 DO j = 1,sNy
226 jmc 1.15 DO i = 1,sNx
227     tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
228     & *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))
229     ENDDO
230 jmc 1.13 ENDDO
231 jmc 1.15 ENDDO
232 jmc 1.13 ENDDO
233 jmc 1.15 ENDDO
234     CALL DIAGNOSTICS_FILL(tmpMk,'WVELTH ',0,Nr,0,1,1,myThid)
235     ENDIF
236 jmc 1.31
237 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('UVELSLT ',myThid) ) THEN
238     DO bj = myByLo(myThid), myByHi(myThid)
239     DO bi = myBxLo(myThid), myBxHi(myThid)
240     DO K=1,Nr
241 jmc 1.13 DO j = 1,sNy
242 jmc 1.15 DO i = 1,sNx+1
243     tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
244     & *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))
245     ENDDO
246 jmc 1.13 ENDDO
247 jmc 1.15 ENDDO
248 jmc 1.13 ENDDO
249 jmc 1.15 ENDDO
250     CALL DIAGNOSTICS_FILL(tmpMk,'UVELSLT ',0,Nr,0,1,1,myThid)
251     ENDIF
252 jmc 1.31
253 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('VVELSLT ',myThid) ) THEN
254     DO bj = myByLo(myThid), myByHi(myThid)
255     DO bi = myBxLo(myThid), myBxHi(myThid)
256     DO K=1,Nr
257     DO j = 1,sNy+1
258     DO i = 1,sNx
259     tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
260     & *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))
261     ENDDO
262 jmc 1.13 ENDDO
263 jmc 1.15 ENDDO
264 jmc 1.13 ENDDO
265 jmc 1.15 ENDDO
266     CALL DIAGNOSTICS_FILL(tmpMk,'VVELSLT ',0,Nr,0,1,1,myThid)
267     ENDIF
268    
269     IF ( DIAGNOSTICS_IS_ON('WVELSLT ',myThid) ) THEN
270     DO bj = myByLo(myThid), myByHi(myThid)
271     DO bi = myBxLo(myThid), myBxHi(myThid)
272     DO K=1,Nr
273     km1 = MAX(k-1,1)
274 jmc 1.13 DO j = 1,sNy
275 jmc 1.15 DO i = 1,sNx
276     tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
277     & *(salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))
278     ENDDO
279 jmc 1.13 ENDDO
280 jmc 1.15 ENDDO
281 jmc 1.13 ENDDO
282 jmc 1.15 ENDDO
283     CALL DIAGNOSTICS_FILL(tmpMk,'WVELSLT ',0,Nr,0,1,1,myThid)
284     ENDIF
285 jmc 1.31
286 molod 1.28 IF ( DIAGNOSTICS_IS_ON('UVELPHI ',myThid) ) THEN
287     DO bj = myByLo(myThid), myByHi(myThid)
288     DO bi = myBxLo(myThid), myBxHi(myThid)
289     DO K=1,Nr
290     DO j = 1,sNy
291     DO i = 1,sNx+1
292 dfer 1.32 tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*hFacW(i,j,k,bi,bj)
293     & *0.5 _d 0*(totPhiHyd(i,j,K,bi,bj)+totPhiHyd(i-1,j,K,bi,bj))
294 molod 1.28 ENDDO
295     ENDDO
296     ENDDO
297     ENDDO
298     ENDDO
299     CALL DIAGNOSTICS_FILL(tmpMk,'UVELPHI ',0,Nr,0,1,1,myThid)
300     ENDIF
301 jmc 1.31
302 molod 1.28 IF ( DIAGNOSTICS_IS_ON('VVELPHI ',myThid) ) THEN
303     DO bj = myByLo(myThid), myByHi(myThid)
304     DO bi = myBxLo(myThid), myBxHi(myThid)
305     DO K=1,Nr
306     DO j = 1,sNy+1
307     DO i = 1,sNx
308 dfer 1.32 tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*hFacS(i,j,k,bi,bj)
309     & *0.5 _d 0*(totPhiHyd(i,j,K,bi,bj)+totPhiHyd(i,j-1,K,bi,bj))
310 molod 1.28 ENDDO
311     ENDDO
312     ENDDO
313     ENDDO
314     ENDDO
315     CALL DIAGNOSTICS_FILL(tmpMk,'VVELPHI ',0,Nr,0,1,1,myThid)
316     ENDIF
317 jmc 1.31
318 jmc 1.33 IF ( DIAGNOSTICS_IS_ON('RCENTER ',myThid) ) THEN
319 molod 1.20 DO bj = myByLo(myThid), myByHi(myThid)
320     DO bi = myBxLo(myThid), myBxHi(myThid)
321 jmc 1.26 DO j = 1,sNy
322     DO i = 1,sNx
323     tmp1k(i,j,bi,bj) = R_low(i,j,bi,bj)
324     ENDDO
325     ENDDO
326     DO k = Nr,1,-1
327     DO j = 1,sNy
328     DO i = 1,sNx
329     tmpMk(i,j,k,bi,bj) = tmp1k(i,j,bi,bj)
330 jmc 1.34 & + (rF(k)-rC(k))*hFacC(i,j,k,bi,bj)
331     C above: more general (setInterFDr/setCenterDr) than line below
332     c & + drF(k)*hFacC(i,j,k,bi,bj)*0.5 _d 0
333 jmc 1.26 tmp1k(i,j,bi,bj) = tmp1k(i,j,bi,bj)
334     & + drF(k)*hFacC(i,j,k,bi,bj)
335     ENDDO
336     ENDDO
337     ENDDO
338 molod 1.20 ENDDO
339     ENDDO
340 jmc 1.33 CALL DIAGNOSTICS_FILL(tmpMk,'RCENTER ',0,Nr,0,1,1,myThid)
341 molod 1.20 ENDIF
342    
343 molod 1.29 C First fill sequence for state variable tendency diagnostics: subtract state variable
344     C NOTE: send a '0' for the bibjflag and allow counter to be incremented
345     C (next fill for these diagnostics will NOT allow counter to be incremented)
346    
347     IF ( DIAGNOSTICS_IS_ON('TOTUTEND',myThid) ) THEN
348     DO bj = myByLo(myThid), myByHi(myThid)
349     DO bi = myBxLo(myThid), myBxHi(myThid)
350     DO K=1,Nr
351     DO j = 1,sNy
352 jmc 1.35 DO i = 1,sNx+1
353 molod 1.36 tmpMk(i,j,K,bi,bj) = -uVel(i,j,K,bi,bj)
354 molod 1.30 . *86400./dTtracerLev(1)
355 molod 1.29 ENDDO
356     ENDDO
357     ENDDO
358     ENDDO
359     ENDDO
360     CALL DIAGNOSTICS_FILL(tmpMk,'TOTUTEND',0,Nr,0,1,1,myThid)
361     ENDIF
362    
363     IF ( DIAGNOSTICS_IS_ON('TOTVTEND',myThid) ) THEN
364     DO bj = myByLo(myThid), myByHi(myThid)
365     DO bi = myBxLo(myThid), myBxHi(myThid)
366     DO K=1,Nr
367 jmc 1.35 DO j = 1,sNy+1
368 molod 1.29 DO i = 1,sNx
369     tmpMk(i,j,K,bi,bj) = -vVel(i,j,K,bi,bj)
370 molod 1.30 . *86400./dTtracerLev(1)
371 molod 1.29 ENDDO
372     ENDDO
373     ENDDO
374     ENDDO
375     ENDDO
376     CALL DIAGNOSTICS_FILL(tmpMk,'TOTVTEND',0,Nr,0,1,1,myThid)
377     ENDIF
378 jmc 1.31
379 molod 1.29 IF ( DIAGNOSTICS_IS_ON('TOTTTEND',myThid) ) THEN
380     DO bj = myByLo(myThid), myByHi(myThid)
381     DO bi = myBxLo(myThid), myBxHi(myThid)
382     DO K=1,Nr
383     DO j = 1,sNy
384     DO i = 1,sNx
385     tmpMk(i,j,K,bi,bj) = -theta(i,j,K,bi,bj)
386 molod 1.30 . *86400./dTtracerLev(1)
387 molod 1.29 ENDDO
388     ENDDO
389     ENDDO
390     ENDDO
391     ENDDO
392     CALL DIAGNOSTICS_FILL(tmpMk,'TOTTTEND',0,Nr,0,1,1,myThid)
393     ENDIF
394 jmc 1.31
395 molod 1.29 IF ( DIAGNOSTICS_IS_ON('TOTSTEND',myThid) ) THEN
396     DO bj = myByLo(myThid), myByHi(myThid)
397     DO bi = myBxLo(myThid), myBxHi(myThid)
398     DO K=1,Nr
399     DO j = 1,sNy
400     DO i = 1,sNx
401     tmpMk(i,j,K,bi,bj) = -salt(i,j,K,bi,bj)
402 molod 1.30 . *86400./dTtracerLev(1)
403 molod 1.29 ENDDO
404     ENDDO
405     ENDDO
406     ENDDO
407     ENDDO
408     CALL DIAGNOSTICS_FILL(tmpMk,'TOTSTEND',0,Nr,0,1,1,myThid)
409     ENDIF
410    
411 jmc 1.15 C-- fill momentum state-var diagnostics: end
412 jmc 1.13 ENDIF
413 jmc 1.15
414     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
415    
416     IF ( selectVars.EQ.1 .OR. selectVars.EQ.3 ) THEN
417     C-- fill tracer state-var diagnostics:
418    
419     CALL DIAGNOSTICS_FILL(theta,'THETA ',0,Nr,0,1,1,myThid)
420     CALL DIAGNOSTICS_FILL(salt, 'SALT ',0,Nr,0,1,1,myThid)
421 jmc 1.21
422 molod 1.24 #ifdef ALLOW_FIZHI
423     IF((useFIZHI).and.(DIAGNOSTICS_IS_ON('RELHUM ',myThid)))THEN
424     kappa = getcon('KAPPA')
425     do bj = myByLo(myThid), myByHi(myThid)
426     do bi = myBxLo(myThid), myBxHi(myThid)
427     do j = 1,sNy
428     do i = 1,sNx
429     do K = 1,Nr
430     dummy1 = theta(i,j,k,bi,bj) * ((rc(k)/100.)/1000.)**kappa
431     dummy2 = rc(k) / 100.
432     call qsat(dummy1,dummy2,dummy3,dummy4,.false.)
433 jmc 1.31 tmpMk(i,j,K,bi,bj) = hfacC(i,j,K,bi,bj) *
434 molod 1.24 . salt(i,j,k,bi,bj) * 100. / dummy3
435     enddo
436     enddo
437     enddo
438     enddo
439     enddo
440     CALL DIAGNOSTICS_FILL(tmpMk, 'RELHUM ',0,Nr,0,1,1,myThid)
441     ENDIF
442     #endif /* ALLOW_FIZHI */
443    
444 jmc 1.21 CALL DIAGNOSTICS_SCALE_FILL(theta,tmpFac,2,
445     & 'THETASQ ',0,Nr,0,1,1,myThid)
446     CALL DIAGNOSTICS_SCALE_FILL(salt,tmpFac,2,
447     & 'SALTSQ ',0,Nr,0,1,1,myThid)
448 jmc 1.31
449 jmc 1.25 c IF ( DIAGNOSTICS_IS_ON('SST ',myThid) ) THEN
450     c DO bj = myByLo(myThid), myByHi(myThid)
451     c DO bi = myBxLo(myThid), myBxHi(myThid)
452     c DO j = 1,sNy
453     c DO i = 1,sNx
454     c tmp1k(i,j,bi,bj) = THETA(i,j,1,bi,bj)
455     c ENDDO
456     c ENDDO
457     c ENDDO
458     c ENDDO
459     c CALL DIAGNOSTICS_FILL(tmp1k,'SST ',0,1,0,1,1,myThid)
460     c ENDIF
461 jmc 1.31
462 jmc 1.25 c IF ( DIAGNOSTICS_IS_ON('SSS ',myThid) ) THEN
463     c DO bj = myByLo(myThid), myByHi(myThid)
464     c DO bi = myBxLo(myThid), myBxHi(myThid)
465     c DO j = 1,sNy
466     c DO i = 1,sNx
467     c tmp1k(i,j,bi,bj) = SALT(i,j,1,bi,bj)
468     c ENDDO
469     c ENDDO
470     c ENDDO
471     c ENDDO
472     c CALL DIAGNOSTICS_FILL(tmp1k,'SSS ',0,1,0,1,1,myThid)
473     c ENDIF
474 jmc 1.15
475 jmc 1.31 IF ( fluidIsWater .AND.
476     & ( DIAGNOSTICS_IS_ON('SALTanom',myThid)
477     & .OR.DIAGNOSTICS_IS_ON('SALTSQan',myThid) ) ) THEN
478 dimitri 1.18 DO bj = myByLo(myThid), myByHi(myThid)
479     DO bi = myBxLo(myThid), myBxHi(myThid)
480     DO K=1,Nr
481     DO j = 1,sNy
482     DO i = 1,sNx
483 jmc 1.25 tmpMk(i,j,K,bi,bj) = salt(i,j,K,bi,bj)-35. _d 0
484 dimitri 1.18 ENDDO
485     ENDDO
486     ENDDO
487     ENDDO
488     ENDDO
489 jmc 1.31 CALL DIAGNOSTICS_FILL( tmpMk,'SALTanom',0,Nr,0,1,1,myThid)
490     CALL DIAGNOSTICS_SCALE_FILL(tmpMk,tmpFac,2,
491     & 'SALTSQan',0,Nr,0,1,1,myThid)
492 dimitri 1.18 ENDIF
493 jmc 1.31
494 jmc 1.15 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
495 jmc 1.13
496 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('UVELMASS',myThid) ) THEN
497     DO bj = myByLo(myThid), myByHi(myThid)
498     DO bi = myBxLo(myThid), myBxHi(myThid)
499     DO K=1,Nr
500 jmc 1.13 DO j = 1,sNy
501 jmc 1.35 DO i = 1,sNx+1
502 jmc 1.31 tmpMk(i,j,K,bi,bj)
503 edhill 1.11 & = uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj)
504 jmc 1.13 ENDDO
505     ENDDO
506 jmc 1.15 ENDDO
507 jmc 1.13 ENDDO
508 jmc 1.15 ENDDO
509     CALL DIAGNOSTICS_FILL(tmpMk,'UVELMASS',0,Nr,0,1,1,myThid)
510     ENDIF
511    
512     IF ( DIAGNOSTICS_IS_ON('VVELMASS',myThid) ) THEN
513     DO bj = myByLo(myThid), myByHi(myThid)
514     DO bi = myBxLo(myThid), myBxHi(myThid)
515     DO K=1,Nr
516 jmc 1.35 DO j = 1,sNy+1
517 jmc 1.13 DO i = 1,sNx
518 jmc 1.31 tmpMk(i,j,K,bi,bj)
519 edhill 1.11 & = vVel(i,j,K,bi,bj)*hFacS(i,j,K,bi,bj)
520 jmc 1.13 ENDDO
521     ENDDO
522 jmc 1.15 ENDDO
523 jmc 1.13 ENDDO
524 jmc 1.15 ENDDO
525     CALL DIAGNOSTICS_FILL(tmpMk,'VVELMASS',0,Nr,0,1,1,myThid)
526     ENDIF
527    
528     CALL DIAGNOSTICS_FILL(wVel, 'WVELMASS',0,Nr,0,1,1,myThid)
529 jmc 1.13
530 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('UTHMASS ',myThid) ) THEN
531     DO bj = myByLo(myThid), myByHi(myThid)
532     DO bi = myBxLo(myThid), myBxHi(myThid)
533     DO K=1,Nr
534 jmc 1.13 DO j = 1,sNy
535 jmc 1.15 DO i = 1,sNx+1
536     tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
537 jmc 1.13 & *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))
538     & * hFacW(i,j,K,bi,bj)
539 jmc 1.15 ENDDO
540 jmc 1.13 ENDDO
541 jmc 1.15 ENDDO
542 jmc 1.13 ENDDO
543 jmc 1.15 ENDDO
544     CALL DIAGNOSTICS_FILL(tmpMk,'UTHMASS ',0,Nr,0,1,1,myThid)
545     ENDIF
546    
547     IF ( DIAGNOSTICS_IS_ON('VTHMASS ',myThid) ) THEN
548     DO bj = myByLo(myThid), myByHi(myThid)
549     DO bi = myBxLo(myThid), myBxHi(myThid)
550     DO K=1,Nr
551     DO j = 1,sNy+1
552     DO i = 1,sNx
553     tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
554 jmc 1.13 & *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))
555     & * hFacS(i,j,K,bi,bj)
556 jmc 1.15 ENDDO
557     ENDDO
558     ENDDO
559     ENDDO
560     ENDDO
561     CALL DIAGNOSTICS_FILL(tmpMk,'VTHMASS ',0,Nr,0,1,1,myThid)
562     ENDIF
563 jmc 1.31
564 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('WTHMASS ',myThid) ) THEN
565     DO bj = myByLo(myThid), myByHi(myThid)
566     DO bi = myBxLo(myThid), myBxHi(myThid)
567     DO K=1,Nr
568     km1 = MAX(k-1,1)
569     DO j = 1,sNy
570     DO i = 1,sNx
571     tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
572     & *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))
573     ENDDO
574 jmc 1.13 ENDDO
575 jmc 1.15 ENDDO
576 jmc 1.13 ENDDO
577 jmc 1.15 ENDDO
578     CALL DIAGNOSTICS_FILL(tmpMk,'WTHMASS ',0,Nr,0,1,1,myThid)
579     ENDIF
580    
581     IF ( DIAGNOSTICS_IS_ON('USLTMASS',myThid) ) THEN
582     DO bj = myByLo(myThid), myByHi(myThid)
583     DO bi = myBxLo(myThid), myBxHi(myThid)
584     DO K=1,Nr
585 jmc 1.13 DO j = 1,sNy
586 jmc 1.15 DO i = 1,sNx+1
587     tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
588 jmc 1.13 & *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))
589     & * hFacW(i,j,K,bi,bj)
590 jmc 1.15 ENDDO
591 jmc 1.13 ENDDO
592 jmc 1.15 ENDDO
593 jmc 1.13 ENDDO
594 jmc 1.15 ENDDO
595     CALL DIAGNOSTICS_FILL(tmpMk,'USLTMASS',0,Nr,0,1,1,myThid)
596     ENDIF
597    
598     IF ( DIAGNOSTICS_IS_ON('VSLTMASS',myThid) ) THEN
599     DO bj = myByLo(myThid), myByHi(myThid)
600     DO bi = myBxLo(myThid), myBxHi(myThid)
601     DO K=1,Nr
602     DO j = 1,sNy+1
603     DO i = 1,sNx
604     tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
605 jmc 1.13 & *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))
606     & * hFacS(i,j,K,bi,bj)
607 jmc 1.15 ENDDO
608     ENDDO
609     ENDDO
610     ENDDO
611     ENDDO
612     CALL DIAGNOSTICS_FILL(tmpMk,'VSLTMASS',0,Nr,0,1,1,myThid)
613     ENDIF
614 jmc 1.31
615 jmc 1.15 IF ( DIAGNOSTICS_IS_ON('WSLTMASS',myThid) ) THEN
616     DO bj = myByLo(myThid), myByHi(myThid)
617     DO bi = myBxLo(myThid), myBxHi(myThid)
618     DO K=1,Nr
619     km1 = MAX(k-1,1)
620     DO j = 1,sNy
621     DO i = 1,sNx
622     tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
623     & *(salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))
624     ENDDO
625 jmc 1.13 ENDDO
626 jmc 1.15 ENDDO
627 jmc 1.13 ENDDO
628 jmc 1.15 ENDDO
629     CALL DIAGNOSTICS_FILL(tmpMk,'WSLTMASS',0,Nr,0,1,1,myThid)
630     ENDIF
631 jmc 1.31
632 jmc 1.15 C-- fill tracer state-var diagnostics: end
633 jmc 1.13 ENDIF
634 jmc 1.15
635 molod 1.29 IF ( selectVars.EQ.4 ) THEN
636     C Second fill sequence for state variable tendency diagnostics: add state variable
637     C NOTE: send a '-1' for the bibjflag and allow counter to be incremented
638     C this means that diag fill is called from inside the bi-bj loop
639    
640     IF ( DIAGNOSTICS_IS_ON('TOTUTEND',myThid) ) THEN
641     DO bj = myByLo(myThid), myByHi(myThid)
642     DO bi = myBxLo(myThid), myBxHi(myThid)
643     DO K=1,Nr
644     DO j = 1,sNy
645 jmc 1.35 DO i = 1,sNx+1
646 molod 1.29 tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)
647 molod 1.30 . *86400./dTtracerLev(1)
648 molod 1.29 ENDDO
649     ENDDO
650     ENDDO
651     CALL DIAGNOSTICS_FILL(tmpMk,'TOTUTEND',0,Nr,-1,bi,bj,myThid)
652     ENDDO
653     ENDDO
654     ENDIF
655    
656     IF ( DIAGNOSTICS_IS_ON('TOTVTEND',myThid) ) THEN
657     DO bj = myByLo(myThid), myByHi(myThid)
658     DO bi = myBxLo(myThid), myBxHi(myThid)
659     DO K=1,Nr
660 jmc 1.35 DO j = 1,sNy+1
661 molod 1.29 DO i = 1,sNx
662     tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)
663 molod 1.30 . *86400./dTtracerLev(1)
664 molod 1.29 ENDDO
665     ENDDO
666     ENDDO
667     CALL DIAGNOSTICS_FILL(tmpMk,'TOTVTEND',0,Nr,-1,bi,bj,myThid)
668     ENDDO
669     ENDDO
670     ENDIF
671 jmc 1.31
672 molod 1.29 IF ( DIAGNOSTICS_IS_ON('TOTTTEND',myThid) ) THEN
673     DO bj = myByLo(myThid), myByHi(myThid)
674     DO bi = myBxLo(myThid), myBxHi(myThid)
675     DO K=1,Nr
676     DO j = 1,sNy
677     DO i = 1,sNx
678     tmpMk(i,j,K,bi,bj) = theta(i,j,K,bi,bj)
679 molod 1.30 . *86400./dTtracerLev(1)
680 molod 1.29 ENDDO
681     ENDDO
682     ENDDO
683     CALL DIAGNOSTICS_FILL(tmpMk,'TOTTTEND',0,Nr,-1,bi,bj,myThid)
684     ENDDO
685     ENDDO
686     ENDIF
687 jmc 1.31
688 molod 1.29 IF ( DIAGNOSTICS_IS_ON('TOTSTEND',myThid) ) THEN
689     DO bj = myByLo(myThid), myByHi(myThid)
690     DO bi = myBxLo(myThid), myBxHi(myThid)
691     DO K=1,Nr
692     DO j = 1,sNy
693     DO i = 1,sNx
694     tmpMk(i,j,K,bi,bj) = salt(i,j,K,bi,bj)
695 molod 1.30 . *86400./dTtracerLev(1)
696 molod 1.29 ENDDO
697     ENDDO
698     ENDDO
699     CALL DIAGNOSTICS_FILL(tmpMk,'TOTSTEND',0,Nr,-1,bi,bj,myThid)
700     ENDDO
701     ENDDO
702     ENDIF
703    
704     C-- fill state tendency diagnostics the second time: end
705     ENDIF
706    
707 jmc 1.7 #endif /* ALLOW_DIAGNOSTICS */
708 jmc 1.31
709     RETURN
710 jmc 1.13 END

  ViewVC Help
Powered by ViewVC 1.1.22