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

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

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

revision 1.7 by jmc, Mon Jun 14 21:54:47 2004 UTC revision 1.24 by molod, Tue Aug 16 21:29:38 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "DIAG_OPTIONS.h"
 #include "CPP_OPTIONS.h"  
5    
6         subroutine diagnostics_fill_state(myThid)  CBOP
7         implicit none  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  #include "SIZE.h"  #include "SIZE.h"
22  #include "EEPARAMS.h"  #include "EEPARAMS.h"
23    #include "PARAMS.h"
24  #include "GRID.h"  #include "GRID.h"
25  #include "DYNVARS.h"  #include "DYNVARS.h"
26    #include "SURFACE.h"
27    
28        integer myThid  C     !INPUT/OUTPUT PARAMETERS:
29    C     == Routine arguments ==
30    C     selectVars :: select which group of dianostics variables to fill-in
31    C            = 1 :: fill-in diagnostics for tracer   variables only
32    C            = 2 :: fill-in diagnostics for momentum variables only
33    C            = 3 :: fill-in diagnostics for momentum & tracer variables
34    C     myThid     :: my Thread Id number
35          INTEGER selectVars
36          INTEGER myThid
37    
38  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
39        _RL dummy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)  C     !LOCAL VARIABLES:
40        integer i,j,K,bi,bj  C     == Local variables ==
41        integer km1        LOGICAL  DIAGNOSTICS_IS_ON
42          EXTERNAL DIAGNOSTICS_IS_ON
43          call fill_diagnostics(myThid,'ETAN    ',0,1,0,1,1,etaN)        _RL tmpMk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
44          _RL tmpMk1(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr+1,nSx,nSy)
45          do bj = myByLo(myThid), myByHi(myThid)        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
46          do bi = myBxLo(myThid), myBxHi(myThid)        _RL tmpFac, uBarC, vBarC
47            do j = 1,sNy        _RL dummy1, dummy2, dummy3, dummy4, kappa, getcon
48            do i = 1,sNx        INTEGER i,j,K,bi,bj
49             dummy(i,j,1,bi,bj) = etaN(i,j,bi,bj)*etaN(i,j,bi,bj)        INTEGER km1
50            enddo        
51            enddo        tmpFac = 1. _d 0
52          enddo  
53          enddo        IF ( selectVars .GE. 2 ) THEN
54          call fill_diagnostics(myThid,'ETANSQ  ',0,1,0,1,1,dummy)  C--   fill momentum state-var diagnostics:
55    
56          call fill_diagnostics(myThid,'UVEL    ',0,Nr,0,1,1,uVel)          CALL DIAGNOSTICS_FILL(etaN, 'ETAN    ',0, 1,0,1,1,myThid)
57          call fill_diagnostics(myThid,'VVEL    ',0,Nr,0,1,1,vVel)  
58          call fill_diagnostics(myThid,'WVEL    ',0,Nr,0,1,1,wVel)          IF ( DIAGNOSTICS_IS_ON('RSURF   ',myThid) ) THEN
59          call fill_diagnostics(myThid,'THETA   ',0,Nr,0,1,1,theta)           DO bj = myByLo(myThid), myByHi(myThid)
60          call fill_diagnostics(myThid,'SALT    ',0,Nr,0,1,1,salt)            DO bi = myBxLo(myThid), myBxHi(myThid)
61               DO j = 1,sNy
62          do bj = myByLo(myThid), myByHi(myThid)              DO i = 1,sNx
63          do bi = myBxLo(myThid), myBxHi(myThid)                tmp1k(i,j,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
64           do K=1,Nr              ENDDO
65            do j = 1,sNy             ENDDO
66            do i = 1,sNx            ENDDO
67             dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*uVel(i,j,K,bi,bj)           ENDDO
68            enddo           CALL DIAGNOSTICS_FILL(tmp1k,'RSURF   ',0,1,0,1,1,myThid)
69            enddo          ENDIF
70           enddo  
71          enddo          CALL DIAGNOSTICS_SCALE_FILL(etaN,tmpFac,2,
72          enddo       &                              'ETANSQ  ',0, 1,0,1,1,myThid)
73          call fill_diagnostics(myThid,'UVELSQ  ',0,Nr,0,1,1,dummy)        
74    #ifdef EXACT_CONSERV
75          do bj = myByLo(myThid), myByHi(myThid)          CALL DIAGNOSTICS_SCALE_FILL(dEtaHdt,tmpFac,2,
76          do bi = myBxLo(myThid), myBxHi(myThid)       &                              'DETADT2 ',0, 1,0,1,1,myThid)
77           do K=1,Nr  #endif
78            do j = 1,sNy        
79            do i = 1,sNx          CALL DIAGNOSTICS_FILL(uVel, 'UVEL    ',0,Nr,0,1,1,myThid)
80             dummy(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*vVel(i,j,K,bi,bj)          CALL DIAGNOSTICS_FILL(vVel, 'VVEL    ',0,Nr,0,1,1,myThid)
81            enddo          CALL DIAGNOSTICS_FILL(wVel, 'WVEL    ',0,Nr,0,1,1,myThid)
82            enddo        
83           enddo          CALL DIAGNOSTICS_SCALE_FILL(uVel,tmpFac,2,
84          enddo       &                              'UVELSQ  ',0,Nr,0,1,1,myThid)
85          enddo          CALL DIAGNOSTICS_SCALE_FILL(vVel,tmpFac,2,
86          call fill_diagnostics(myThid,'VVELSQ  ',0,Nr,0,1,1,dummy)       &                              'VVELSQ  ',0,Nr,0,1,1,myThid)
87            CALL DIAGNOSTICS_SCALE_FILL(wVel,tmpFac,2,
88          do bj = myByLo(myThid), myByHi(myThid)       &                              'WVELSQ  ',0,Nr,0,1,1,myThid)
89          do bi = myBxLo(myThid), myBxHi(myThid)  
90           do K=1,Nr          IF ( DIAGNOSTICS_IS_ON('UVEL_k2 ',myThid) ) THEN
91            do j = 1,sNy           DO bj = myByLo(myThid), myByHi(myThid)
92            do i = 1,sNx            DO bi = myBxLo(myThid), myBxHi(myThid)
93             dummy(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*wVel(i,j,K,bi,bj)             DO j = 1,sNy
94            enddo              DO i = 1,sNx
95            enddo                tmp1k(i,j,bi,bj) = UVEL(i,j,2,bi,bj)
96           enddo              ENDDO
97          enddo             ENDDO
98          enddo            ENDDO
99          call fill_diagnostics(myThid,'WVELSQ  ',0,Nr,0,1,1,dummy)           ENDDO
100             CALL DIAGNOSTICS_FILL(tmp1k,'UVEL_k2 ',0,1,0,1,1,myThid)
101          do bj = myByLo(myThid), myByHi(myThid)          ENDIF
102          do bi = myBxLo(myThid), myBxHi(myThid)        
103           do K=1,Nr          IF ( DIAGNOSTICS_IS_ON('VVEL_k2 ',myThid) ) THEN
104            do j = 1,sNy           DO bj = myByLo(myThid), myByHi(myThid)
105            do i = 1,sNx            DO bi = myBxLo(myThid), myBxHi(myThid)
106             dummy(i,j,K,bi,bj) = theta(i,j,K,bi,bj)*theta(i,j,K,bi,bj)             DO j = 1,sNy
107            enddo              DO i = 1,sNx
108            enddo                tmp1k(i,j,bi,bj) = VVEL(i,j,2,bi,bj)
109           enddo              ENDDO
110          enddo             ENDDO
111          enddo            ENDDO
112          call fill_diagnostics(myThid,'THETASQ ',0,Nr,0,1,1,dummy)           ENDDO
113             CALL DIAGNOSTICS_FILL(tmp1k,'VVEL_k2 ',0,1,0,1,1,myThid)
114          do bj = myByLo(myThid), myByHi(myThid)          ENDIF
115          do bi = myBxLo(myThid), myBxHi(myThid)        
116           do K=1,Nr  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
117            do j = 1,sNy  
118            do i = 1,sNx          IF ( DIAGNOSTICS_IS_ON('UV_VEL_C',myThid) ) THEN
119             dummy(i,j,K,bi,bj) = salt(i,j,K,bi,bj)*salt(i,j,K,bi,bj)           DO bj = myByLo(myThid), myByHi(myThid)
120            enddo            DO bi = myBxLo(myThid), myBxHi(myThid)
121            enddo             DO K=1,Nr
122           enddo              DO j = 1,sNy
123          enddo               DO i = 1,sNx
124          enddo                uBarC = 0.5 _d 0
125          call fill_diagnostics(myThid,'SALTSQ  ',0,Nr,0,1,1,dummy)       &           *(uVel(i,j,K,bi,bj)+uVel(i+1,j,K,bi,bj))
126                  vBarC = 0.5 _d 0
127          do bj = myByLo(myThid), myByHi(myThid)       &           *(vVel(i,j,K,bi,bj)+vVel(i,j+1,K,bi,bj))
128          do bi = myBxLo(myThid), myBxHi(myThid)                tmpMk(i,j,K,bi,bj) =
129           do K=1,Nr       &            ( angleCosC(i,j,bi,bj)*uBarC
130            do j = 1,sNy       &             -angleSinC(i,j,bi,bj)*vBarC )
131            do i = 1,sNx       &           *( angleSinC(i,j,bi,bj)*uBarC
132             dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*vVel(i,j,K,bi,bj)       &             +angleCosC(i,j,bi,bj)*vBarC )
133            enddo               ENDDO
134            enddo              ENDDO
135           enddo             ENDDO
136          enddo            ENDDO
137          enddo           ENDDO
138          call fill_diagnostics(myThid,'UVELVVEL',0,Nr,0,1,1,dummy)           CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_C',0,Nr,0,1,1,myThid)
139            ENDIF
140          do bj = myByLo(myThid), myByHi(myThid)        
141          do bi = myBxLo(myThid), myBxHi(myThid)          IF ( DIAGNOSTICS_IS_ON('UV_VEL_Z',myThid) ) THEN
142           do K=1,Nr           DO bj = myByLo(myThid), myByHi(myThid)
143            do j = 1,sNy            DO bi = myBxLo(myThid), myBxHi(myThid)
144            do i = 1,sNx             DO K=1,Nr
145             dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*              DO j = 1,sNy+1
146       &         0.5*(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))               DO i = 1,sNx+1
147            enddo                tmpMk(i,j,K,bi,bj) = 0.25 _d 0
148            enddo       &           *(uVel(i,j-1,K,bi,bj)+uVel(i,j,K,bi,bj))
149           enddo       &           *(vVel(i-1,j,K,bi,bj)+vVel(i,j,K,bi,bj))
150          enddo               ENDDO
151          enddo              ENDDO
152          call fill_diagnostics(myThid,'UVELTH  ',0,Nr,0,1,1,dummy)             ENDDO
153              ENDDO
154          do bj = myByLo(myThid), myByHi(myThid)           ENDDO
155          do bi = myBxLo(myThid), myBxHi(myThid)           CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_Z',0,Nr,0,1,1,myThid)
156           do K=1,Nr          ENDIF
157            do j = 1,sNy        
158            do i = 1,sNx          IF ( DIAGNOSTICS_IS_ON('WU_VEL  ',myThid) ) THEN
159             dummy(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*           DO bj = myByLo(myThid), myByHi(myThid)
160       &         0.5*(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))            DO bi = myBxLo(myThid), myBxHi(myThid)
161            enddo             DO K=1,Nr
162            enddo              km1 = MAX(k-1,1)
163           enddo              DO j = 1,sNy
164          enddo               DO i = 1,sNx+1
165          enddo                tmpMk(i,j,K,bi,bj) = 0.25 _d 0
166          call fill_diagnostics(myThid,'VVELTH  ',0,Nr,0,1,1,dummy)       &           *(uVel(i,j,km1,bi,bj)+uVel(i,j,K,bi,bj))
167         &           *(wVel(i-1,j,K,bi,bj)*rA(i-1,j,bi,bj)
168          do bj = myByLo(myThid), myByHi(myThid)       &            +wVel( i ,j,K,bi,bj)*rA( i ,j,bi,bj)
169           do bi = myBxLo(myThid), myBxHi(myThid)       &            )*recip_rAw(i,j,bi,bj)
170            do K=1,Nr               ENDDO
171             km1 = MAX(k-1,1)              ENDDO
172               ENDDO
173              ENDDO
174             ENDDO
175             CALL DIAGNOSTICS_FILL(tmpMk,'WU_VEL  ',0,Nr,0,1,1,myThid)
176            ENDIF
177    
178            IF ( DIAGNOSTICS_IS_ON('WV_VEL  ',myThid) ) THEN
179             DO bj = myByLo(myThid), myByHi(myThid)
180              DO bi = myBxLo(myThid), myBxHi(myThid)
181               DO K=1,Nr
182                km1 = MAX(k-1,1)
183                DO j = 1,sNy+1
184                 DO i = 1,sNx
185                  tmpMk(i,j,K,bi,bj) = 0.25 _d 0
186         &           *(vVel(i,j,km1,bi,bj)+vVel(i,j,K,bi,bj))
187         &           *(wVel(i,j-1,K,bi,bj)*rA(i,j-1,bi,bj)
188         &            +wVel(i, j ,K,bi,bj)*rA(i, j ,bi,bj)
189         &            )*recip_rAs(i,j,bi,bj)
190                 ENDDO
191                ENDDO
192               ENDDO
193              ENDDO
194             ENDDO
195             CALL DIAGNOSTICS_FILL(tmpMk,'WV_VEL  ',0,Nr,0,1,1,myThid)
196            ENDIF
197    
198    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
199    
200            IF ( DIAGNOSTICS_IS_ON('UVELTH  ',myThid) ) THEN
201             DO bj = myByLo(myThid), myByHi(myThid)
202              DO bi = myBxLo(myThid), myBxHi(myThid)
203               DO K=1,Nr
204                DO j = 1,sNy
205                 DO i = 1,sNx+1
206                   tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
207         &                  *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))
208                 ENDDO
209                ENDDO
210               ENDDO
211              ENDDO
212             ENDDO
213             CALL DIAGNOSTICS_FILL(tmpMk,'UVELTH  ',0,Nr,0,1,1,myThid)
214            ENDIF
215          
216            IF ( DIAGNOSTICS_IS_ON('VVELTH  ',myThid) ) THEN
217             DO bj = myByLo(myThid), myByHi(myThid)
218              DO bi = myBxLo(myThid), myBxHi(myThid)
219               DO K=1,Nr
220                DO j = 1,sNy+1
221                 DO i = 1,sNx
222                   tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
223         &                  *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))
224                 ENDDO
225                ENDDO
226               ENDDO
227              ENDDO
228             ENDDO
229             CALL DIAGNOSTICS_FILL(tmpMk,'VVELTH  ',0,Nr,0,1,1,myThid)
230            ENDIF
231          
232            IF ( DIAGNOSTICS_IS_ON('WVELTH  ',myThid) ) THEN
233             DO bj = myByLo(myThid), myByHi(myThid)
234              DO bi = myBxLo(myThid), myBxHi(myThid)
235               DO K=1,Nr
236                km1 = MAX(k-1,1)
237                DO j = 1,sNy
238                 DO i = 1,sNx
239                   tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
240         &                  *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))
241                 ENDDO
242                ENDDO
243               ENDDO
244              ENDDO
245             ENDDO
246             CALL DIAGNOSTICS_FILL(tmpMk,'WVELTH  ',0,Nr,0,1,1,myThid)
247            ENDIF
248          
249            IF ( DIAGNOSTICS_IS_ON('UVELSLT ',myThid) ) THEN
250             DO bj = myByLo(myThid), myByHi(myThid)
251              DO bi = myBxLo(myThid), myBxHi(myThid)
252               DO K=1,Nr
253                DO j = 1,sNy
254                 DO i = 1,sNx+1
255                   tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
256         &                  *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))
257                 ENDDO
258                ENDDO
259               ENDDO
260              ENDDO
261             ENDDO
262             CALL DIAGNOSTICS_FILL(tmpMk,'UVELSLT ',0,Nr,0,1,1,myThid)
263            ENDIF
264          
265            IF ( DIAGNOSTICS_IS_ON('VVELSLT ',myThid) ) THEN
266             DO bj = myByLo(myThid), myByHi(myThid)
267              DO bi = myBxLo(myThid), myBxHi(myThid)
268               DO K=1,Nr
269                DO j = 1,sNy+1
270                 DO i = 1,sNx
271                   tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
272         &                  *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))
273                 ENDDO
274                ENDDO
275               ENDDO
276              ENDDO
277             ENDDO
278             CALL DIAGNOSTICS_FILL(tmpMk,'VVELSLT ',0,Nr,0,1,1,myThid)
279            ENDIF
280    
281            IF ( DIAGNOSTICS_IS_ON('WVELSLT ',myThid) ) THEN
282             DO bj = myByLo(myThid), myByHi(myThid)
283              DO bi = myBxLo(myThid), myBxHi(myThid)
284               DO K=1,Nr
285                km1 = MAX(k-1,1)
286                DO j = 1,sNy
287                 DO i = 1,sNx
288                   tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
289         &                  *(salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))
290                 ENDDO
291                ENDDO
292               ENDDO
293              ENDDO
294             ENDDO
295             CALL DIAGNOSTICS_FILL(tmpMk,'WVELSLT ',0,Nr,0,1,1,myThid)
296            ENDIF
297          
298            IF ( DIAGNOSTICS_IS_ON('PRESSURE',myThid) ) THEN
299             DO bj = myByLo(myThid), myByHi(myThid)
300              DO bi = myBxLo(myThid), myBxHi(myThid)
301             do j = 1,sNy             do j = 1,sNy
302              do i = 1,sNx             do i = 1,sNx
303               dummy(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5*              do K = 1,Nr
304       &                 (theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))               tmpMk1(i,j,K,bi,bj) = 0.
305              enddo              enddo
306             enddo             enddo
307            enddo             enddo
308           enddo             do j = 1,sNy
309          enddo             do i = 1,sNx
310          call fill_diagnostics(myThid,'WVELTH  ',0,Nr,0,1,1,dummy)              if(ksurfC(i,j,bi,bj).ne.0.)
311         .          tmpMk1(i,j,ksurfC(i,j,bi,bj),bi,bj) =
312          do bj = myByLo(myThid), myByHi(myThid)       .                            (Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))
313          do bi = myBxLo(myThid), myBxHi(myThid)             enddo
314           do K=1,Nr             enddo
           do j = 1,sNy  
           do i = 1,sNx  
            dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*  
      &         0.5*(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'UVELSLT ',0,Nr,0,1,1,dummy)  
   
         do bj = myByLo(myThid), myByHi(myThid)  
         do bi = myBxLo(myThid), myBxHi(myThid)  
          do K=1,Nr  
           do j = 1,sNy  
           do i = 1,sNx  
            dummy(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*  
      &         0.5*(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'VVELSLT ',0,Nr,0,1,1,dummy)  
   
         do bj = myByLo(myThid), myByHi(myThid)  
          do bi = myBxLo(myThid), myBxHi(myThid)  
           do K=1,Nr  
            km1 = MAX(k-1,1)  
315             do j = 1,sNy             do j = 1,sNy
316              do i = 1,sNx             do i = 1,sNx
317               dummy(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5*              do K = ksurfC(i,j,bi,bj)+1,Nr+1
318       &                 (salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))               tmpMk1(i,j,K,bi,bj) = tmpMk1(i,j,K-1,bi,bj) -
319         .                        drF(K-1)*hfacC(i,j,K-1,bi,bj)
320                enddo
321                do K = 1,Nr
322                 tmpMk(i,j,K,bi,bj) =
323         .           (tmpMk1(i,j,K,bi,bj) + tmpMk1(i,j,K+1,bi,bj)) /2.
324              enddo              enddo
325             enddo             enddo
326            enddo             enddo
327           enddo            ENDDO
328          enddo           ENDDO
329          call fill_diagnostics(myThid,'WVELSLT ',0,Nr,0,1,1,dummy)           CALL DIAGNOSTICS_FILL(tmpMk,'PRESSURE',0,Nr,0,1,1,myThid)
330            ENDIF
331          do bj = myByLo(myThid), myByHi(myThid)  
332          do bi = myBxLo(myThid), myBxHi(myThid)  C--   fill momentum state-var diagnostics: end
333           do K=1,Nr        ENDIF
334            do j = 1,sNy  
335            do i = 1,sNx  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
336             dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj)  
337            enddo        IF ( selectVars.EQ.1 .OR. selectVars.EQ.3 ) THEN
338            enddo  C--   fill tracer state-var diagnostics:
339           enddo  
340          enddo          CALL DIAGNOSTICS_FILL(theta,'THETA   ',0,Nr,0,1,1,myThid)
341          enddo          CALL DIAGNOSTICS_FILL(salt, 'SALT    ',0,Nr,0,1,1,myThid)
342          call fill_diagnostics(myThid,'UVELMASS',0,Nr,0,1,1,salt)  
343    #ifdef ALLOW_FIZHI
344          do bj = myByLo(myThid), myByHi(myThid)        IF((useFIZHI).and.(DIAGNOSTICS_IS_ON('RELHUM  ',myThid)))THEN
345          do bi = myBxLo(myThid), myBxHi(myThid)         kappa = getcon('KAPPA')
346           do K=1,Nr         do bj = myByLo(myThid), myByHi(myThid)
347            do j = 1,sNy         do bi = myBxLo(myThid), myBxHi(myThid)
348            do i = 1,sNx          do j = 1,sNy
349             dummy(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*hFacS(i,j,K,bi,bj)           do i = 1,sNx
350            enddo            do K = 1,Nr
351            enddo             dummy1 = theta(i,j,k,bi,bj) * ((rc(k)/100.)/1000.)**kappa
352           enddo             dummy2 = rc(k) / 100.
353          enddo             call qsat(dummy1,dummy2,dummy3,dummy4,.false.)
354          enddo             tmpMk(i,j,K,bi,bj) = hfacC(i,j,K,bi,bj) *
355          call fill_diagnostics(myThid,'VVELMASS',0,Nr,0,1,1,dummy)       .                    salt(i,j,k,bi,bj) * 100. / dummy3
356               if(k.lt.4) print *,' Temp ',dummy1,' Pres ',dummy2,' q ',
357          do bj = myByLo(myThid), myByHi(myThid)       .      salt(i,j,k,bi,bj),' qstar ',dummy3,' rh ',tmpMk(i,j,K,bi,bj)
358          do bi = myBxLo(myThid), myBxHi(myThid)            enddo
359           do K=1,Nr           enddo
360            do j = 1,sNy          enddo
361            do i = 1,sNx         enddo
362             dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*         enddo
363       .         0.5*(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))         CALL DIAGNOSTICS_FILL(tmpMk, 'RELHUM  ',0,Nr,0,1,1,myThid)
364       .                                * hFacW(i,j,K,bi,bj)        ENDIF
365            enddo  #endif /* ALLOW_FIZHI */
366            enddo  
367           enddo          CALL DIAGNOSTICS_SCALE_FILL(theta,tmpFac,2,
368          enddo       &                              'THETASQ ',0,Nr,0,1,1,myThid)
369          enddo          CALL DIAGNOSTICS_SCALE_FILL(salt,tmpFac,2,
370          call fill_diagnostics(myThid,'UTHMASS ',0,Nr,0,1,1,dummy)       &                              'SALTSQ  ',0,Nr,0,1,1,myThid)
371          
372          do bj = myByLo(myThid), myByHi(myThid)          IF ( DIAGNOSTICS_IS_ON('SST     ',myThid) ) THEN
373          do bi = myBxLo(myThid), myBxHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
374           do K=1,Nr            DO bi = myBxLo(myThid), myBxHi(myThid)
375            do j = 1,sNy             DO j = 1,sNy
376            do i = 1,sNx              DO i = 1,sNx
377             dummy(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*                tmp1k(i,j,bi,bj) = THETA(i,j,1,bi,bj)
378       .         0.5*(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))              ENDDO
379       .                                * hFacS(i,j,K,bi,bj)             ENDDO
380            enddo            ENDDO
381            enddo           ENDDO
382           enddo           CALL DIAGNOSTICS_FILL(tmp1k,'SST     ',0,1,0,1,1,myThid)
383          enddo          ENDIF
384          enddo        
385          call fill_diagnostics(myThid,'VTHMASS ',0,Nr,0,1,1,dummy)          IF ( DIAGNOSTICS_IS_ON('SSS     ',myThid) ) THEN
386             DO bj = myByLo(myThid), myByHi(myThid)
387          do bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
388          do bi = myBxLo(myThid), myBxHi(myThid)             DO j = 1,sNy
389           do K=1,Nr              DO i = 1,sNx
390            do j = 1,sNy                tmp1k(i,j,bi,bj) = SALT(i,j,1,bi,bj)
391            do i = 1,sNx              ENDDO
392             dummy(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*             ENDDO
393       .         0.5*(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))            ENDDO
394       .                                * hFacW(i,j,K,bi,bj)           ENDDO
395            enddo           CALL DIAGNOSTICS_FILL(tmp1k,'SSS     ',0,1,0,1,1,myThid)
396            enddo          ENDIF
397           enddo  
398          enddo          IF ( DIAGNOSTICS_IS_ON('SALTanom',myThid) ) THEN
399          enddo           DO bj = myByLo(myThid), myByHi(myThid)
400          call fill_diagnostics(myThid,'USLTMASS',0,Nr,0,1,1,dummy)            DO bi = myBxLo(myThid), myBxHi(myThid)
401               DO K=1,Nr
402          do bj = myByLo(myThid), myByHi(myThid)              DO j = 1,sNy
403          do bi = myBxLo(myThid), myBxHi(myThid)               DO i = 1,sNx
404           do K=1,Nr                 tmpMk(i,j,K,bi,bj) = salt(i,j,K,bi,bj)-35
405            do j = 1,sNy               ENDDO
406            do i = 1,sNx              ENDDO
407             dummy(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*             ENDDO
408       .         0.5*(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))            ENDDO
409       .                                * hFacS(i,j,K,bi,bj)           ENDDO
410            enddo           CALL DIAGNOSTICS_FILL(tmpMk,'SALTanom',0,Nr,0,1,1,myThid)
411            enddo          ENDIF
412           enddo        
413          enddo          IF ( DIAGNOSTICS_IS_ON('SALTSQan',myThid) ) THEN
414          enddo           DO bj = myByLo(myThid), myByHi(myThid)
415          call fill_diagnostics(myThid,'VSLTMASS',0,Nr,0,1,1,dummy)            DO bi = myBxLo(myThid), myBxHi(myThid)
416               DO K=1,Nr
417                DO j = 1,sNy
418                 DO i = 1,sNx
419                   tmpMk(i,j,K,bi,bj) =
420         &               (salt(i,j,K,bi,bj)-35)*(salt(i,j,K,bi,bj)-35)
421                 ENDDO
422                ENDDO
423               ENDDO
424              ENDDO
425             ENDDO
426             CALL DIAGNOSTICS_FILL(tmpMk,'SALTSQan',0,Nr,0,1,1,myThid)
427            ENDIF
428          
429    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
430    
431            IF ( DIAGNOSTICS_IS_ON('UVELMASS',myThid) ) THEN
432             DO bj = myByLo(myThid), myByHi(myThid)
433              DO bi = myBxLo(myThid), myBxHi(myThid)
434               DO K=1,Nr
435                DO j = 1,sNy
436                  DO i = 1,sNx
437                    tmpMk(i,j,K,bi,bj)
438         &               = uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj)
439                  ENDDO
440                ENDDO
441               ENDDO
442              ENDDO
443             ENDDO
444             CALL DIAGNOSTICS_FILL(tmpMk,'UVELMASS',0,Nr,0,1,1,myThid)
445            ENDIF
446    
447            IF ( DIAGNOSTICS_IS_ON('VVELMASS',myThid) ) THEN
448             DO bj = myByLo(myThid), myByHi(myThid)
449              DO bi = myBxLo(myThid), myBxHi(myThid)
450               DO K=1,Nr
451                DO j = 1,sNy
452                  DO i = 1,sNx
453                    tmpMk(i,j,K,bi,bj)
454         &               = vVel(i,j,K,bi,bj)*hFacS(i,j,K,bi,bj)
455                  ENDDO
456                ENDDO
457               ENDDO
458              ENDDO
459             ENDDO
460             CALL DIAGNOSTICS_FILL(tmpMk,'VVELMASS',0,Nr,0,1,1,myThid)
461            ENDIF
462    
463            CALL DIAGNOSTICS_FILL(wVel, 'WVELMASS',0,Nr,0,1,1,myThid)
464    
465            IF ( DIAGNOSTICS_IS_ON('UTHMASS ',myThid) ) THEN
466             DO bj = myByLo(myThid), myByHi(myThid)
467              DO bi = myBxLo(myThid), myBxHi(myThid)
468               DO K=1,Nr
469                DO j = 1,sNy
470                 DO i = 1,sNx+1
471                   tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
472         &                  *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))
473         &                  * hFacW(i,j,K,bi,bj)
474                 ENDDO
475                ENDDO
476               ENDDO
477              ENDDO
478             ENDDO
479             CALL DIAGNOSTICS_FILL(tmpMk,'UTHMASS ',0,Nr,0,1,1,myThid)
480            ENDIF
481    
482            IF ( DIAGNOSTICS_IS_ON('VTHMASS ',myThid) ) THEN
483             DO bj = myByLo(myThid), myByHi(myThid)
484              DO bi = myBxLo(myThid), myBxHi(myThid)
485               DO K=1,Nr
486                DO j = 1,sNy+1
487                 DO i = 1,sNx
488                   tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
489         &                  *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))
490         &                  * hFacS(i,j,K,bi,bj)
491                 ENDDO
492                ENDDO
493               ENDDO
494              ENDDO
495             ENDDO
496             CALL DIAGNOSTICS_FILL(tmpMk,'VTHMASS ',0,Nr,0,1,1,myThid)
497            ENDIF
498          
499            IF ( DIAGNOSTICS_IS_ON('WTHMASS ',myThid) ) THEN
500             DO bj = myByLo(myThid), myByHi(myThid)
501              DO bi = myBxLo(myThid), myBxHi(myThid)
502               DO K=1,Nr
503                km1 = MAX(k-1,1)
504                DO j = 1,sNy
505                 DO i = 1,sNx
506                   tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
507         &                  *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))
508                 ENDDO
509                ENDDO
510               ENDDO
511              ENDDO
512             ENDDO
513             CALL DIAGNOSTICS_FILL(tmpMk,'WTHMASS ',0,Nr,0,1,1,myThid)
514            ENDIF
515    
516            IF ( DIAGNOSTICS_IS_ON('USLTMASS',myThid) ) THEN
517             DO bj = myByLo(myThid), myByHi(myThid)
518              DO bi = myBxLo(myThid), myBxHi(myThid)
519               DO K=1,Nr
520                DO j = 1,sNy
521                 DO i = 1,sNx+1
522                   tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
523         &                  *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))
524         &                  * hFacW(i,j,K,bi,bj)
525                 ENDDO
526                ENDDO
527               ENDDO
528              ENDDO
529             ENDDO
530             CALL DIAGNOSTICS_FILL(tmpMk,'USLTMASS',0,Nr,0,1,1,myThid)
531            ENDIF
532    
533            IF ( DIAGNOSTICS_IS_ON('VSLTMASS',myThid) ) THEN
534             DO bj = myByLo(myThid), myByHi(myThid)
535              DO bi = myBxLo(myThid), myBxHi(myThid)
536               DO K=1,Nr
537                DO j = 1,sNy+1
538                 DO i = 1,sNx
539                   tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
540         &                  *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))
541         &                  * hFacS(i,j,K,bi,bj)
542                 ENDDO
543                ENDDO
544               ENDDO
545              ENDDO
546             ENDDO
547             CALL DIAGNOSTICS_FILL(tmpMk,'VSLTMASS',0,Nr,0,1,1,myThid)
548            ENDIF
549          
550            IF ( DIAGNOSTICS_IS_ON('WSLTMASS',myThid) ) THEN
551             DO bj = myByLo(myThid), myByHi(myThid)
552              DO bi = myBxLo(myThid), myBxHi(myThid)
553               DO K=1,Nr
554                km1 = MAX(k-1,1)
555                DO j = 1,sNy
556                 DO i = 1,sNx
557                   tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
558         &                  *(salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))
559                 ENDDO
560                ENDDO
561               ENDDO
562              ENDDO
563             ENDDO
564             CALL DIAGNOSTICS_FILL(tmpMk,'WSLTMASS',0,Nr,0,1,1,myThid)
565            ENDIF
566          
567    C--   fill tracer state-var diagnostics: end
568          ENDIF
569    
570  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
571          
572        return        RETURN
573        end        END
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22