/[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.14 by jmc, Wed Dec 15 00:20:37 2004 UTC revision 1.24 by molod, Tue Aug 16 21:29:38 2005 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5    
6         SUBROUTINE DIAGNOSTICS_FILL_STATE( myThid )  CBOP
7    C     !ROUTINE: DIAGNOSTICS_FILL_STATE
8         IMPLICIT NONE  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"  #include "SURFACE.h"
27    
28    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        INTEGER myThid
37    
38  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
39    C     !LOCAL VARIABLES:
40    C     == Local variables ==
41        LOGICAL  DIAGNOSTICS_IS_ON        LOGICAL  DIAGNOSTICS_IS_ON
42        EXTERNAL DIAGNOSTICS_IS_ON        EXTERNAL DIAGNOSTICS_IS_ON
43        _RL tmpMk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _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        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL tmp1k(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
46          _RL tmpFac, uBarC, vBarC
47          _RL dummy1, dummy2, dummy3, dummy4, kappa, getcon
48        INTEGER i,j,K,bi,bj        INTEGER i,j,K,bi,bj
49        INTEGER km1        INTEGER km1
50                
51        CALL DIAGNOSTICS_FILL(etaN,'ETAN    ',0,1,0,1,1,myThid)        tmpFac = 1. _d 0
52          
53        IF ( DIAGNOSTICS_IS_ON('ETANSQ  ',myThid) ) THEN        IF ( selectVars .GE. 2 ) THEN
54         DO bj = myByLo(myThid), myByHi(myThid)  C--   fill momentum state-var diagnostics:
55          DO bi = myBxLo(myThid), myBxHi(myThid)  
56            DO j = 1,sNy          CALL DIAGNOSTICS_FILL(etaN, 'ETAN    ',0, 1,0,1,1,myThid)
             DO i = 1,sNx  
               tmp1k(i,j,bi,bj) = etaN(i,j,bi,bj)*etaN(i,j,bi,bj)  
             ENDDO  
           ENDDO  
         ENDDO  
        ENDDO  
        CALL DIAGNOSTICS_FILL(tmp1k,'ETANSQ  ',0,1,0,1,1,myThid)  
       ENDIF  
         
       CALL DIAGNOSTICS_FILL(phiHydLow,'PHIBOT  ',0,1,0,1,1,myThid)  
57    
58        IF ( DIAGNOSTICS_IS_ON('PHIBOTSQ',myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON('RSURF   ',myThid) ) THEN
59         DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
60          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
61            DO j = 1,sNy             DO j = 1,sNy
62              DO i = 1,sNx              DO i = 1,sNx
63                tmp1k(i,j,bi,bj) = phiHydLow(i,j,bi,bj)                tmp1k(i,j,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
      &                          *phiHydLow(i,j,bi,bj)  
64              ENDDO              ENDDO
65               ENDDO
66            ENDDO            ENDDO
67          ENDDO           ENDDO
68         ENDDO           CALL DIAGNOSTICS_FILL(tmp1k,'RSURF   ',0,1,0,1,1,myThid)
69         CALL DIAGNOSTICS_FILL(tmp1k,'PHIBOTSQ',0,1,0,1,1,myThid)          ENDIF
70        ENDIF  
71            CALL DIAGNOSTICS_SCALE_FILL(etaN,tmpFac,2,
72         &                              'ETANSQ  ',0, 1,0,1,1,myThid)
73                
74  #ifdef EXACT_CONSERV  #ifdef EXACT_CONSERV
75        IF ( DIAGNOSTICS_IS_ON('DETADT2 ',myThid) ) THEN          CALL DIAGNOSTICS_SCALE_FILL(dEtaHdt,tmpFac,2,
76         DO bj = myByLo(myThid), myByHi(myThid)       &                              'DETADT2 ',0, 1,0,1,1,myThid)
         DO bi = myBxLo(myThid), myBxHi(myThid)  
           DO j = 1,sNy  
             DO i = 1,sNx  
               tmp1k(i,j,bi,bj) = dEtaHdt(i,j,bi,bj)*dEtaHdt(i,j,bi,bj)  
             ENDDO  
           ENDDO  
         ENDDO  
        ENDDO  
        CALL DIAGNOSTICS_FILL(tmp1k,'DETADT2 ',0,1,0,1,1,myThid)  
       ENDIF  
77  #endif  #endif
78                
79        CALL DIAGNOSTICS_FILL(totPhihyd,'PHIHYD  ',0,Nr,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(uVel, 'UVEL    ',0,Nr,0,1,1,myThid)
80        CALL DIAGNOSTICS_FILL(uVel, 'UVEL    ',0,Nr,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(vVel, 'VVEL    ',0,Nr,0,1,1,myThid)
81        CALL DIAGNOSTICS_FILL(vVel, 'VVEL    ',0,Nr,0,1,1,myThid)          CALL DIAGNOSTICS_FILL(wVel, 'WVEL    ',0,Nr,0,1,1,myThid)
82        CALL DIAGNOSTICS_FILL(wVel, 'WVEL    ',0,Nr,0,1,1,myThid)        
83        CALL DIAGNOSTICS_FILL(theta,'THETA   ',0,Nr,0,1,1,myThid)          CALL DIAGNOSTICS_SCALE_FILL(uVel,tmpFac,2,
84        CALL DIAGNOSTICS_FILL(salt, 'SALT    ',0,Nr,0,1,1,myThid)       &                              'UVELSQ  ',0,Nr,0,1,1,myThid)
85                  CALL DIAGNOSTICS_SCALE_FILL(vVel,tmpFac,2,
86        IF ( DIAGNOSTICS_IS_ON('UVELSQ  ',myThid) ) THEN       &                              'VVELSQ  ',0,Nr,0,1,1,myThid)
87         DO bj = myByLo(myThid), myByHi(myThid)          CALL DIAGNOSTICS_SCALE_FILL(wVel,tmpFac,2,
88          DO bi = myBxLo(myThid), myBxHi(myThid)       &                              'WVELSQ  ',0,Nr,0,1,1,myThid)
89            DO K=1,Nr  
90              DO j = 1,sNy          IF ( DIAGNOSTICS_IS_ON('UVEL_k2 ',myThid) ) THEN
91                DO i = 1,sNx           DO bj = myByLo(myThid), myByHi(myThid)
92                  tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*uVel(i,j,K,bi,bj)            DO bi = myBxLo(myThid), myBxHi(myThid)
93                ENDDO             DO j = 1,sNy
94                DO i = 1,sNx
95                  tmp1k(i,j,bi,bj) = UVEL(i,j,2,bi,bj)
96              ENDDO              ENDDO
97               ENDDO
98            ENDDO            ENDDO
99          ENDDO           ENDDO
100         ENDDO           CALL DIAGNOSTICS_FILL(tmp1k,'UVEL_k2 ',0,1,0,1,1,myThid)
101         CALL DIAGNOSTICS_FILL(tmpMk,'UVELSQ  ',0,Nr,0,1,1,myThid)          ENDIF
102        ENDIF        
103            IF ( DIAGNOSTICS_IS_ON('VVEL_k2 ',myThid) ) THEN
104        IF ( DIAGNOSTICS_IS_ON('VVELSQ  ',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
105         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
106          DO bi = myBxLo(myThid), myBxHi(myThid)             DO j = 1,sNy
107            DO K=1,Nr              DO i = 1,sNx
108              DO j = 1,sNy                tmp1k(i,j,bi,bj) = VVEL(i,j,2,bi,bj)
               DO i = 1,sNx  
                 tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*vVel(i,j,K,bi,bj)  
               ENDDO  
109              ENDDO              ENDDO
110               ENDDO
111            ENDDO            ENDDO
112          ENDDO           ENDDO
113         ENDDO           CALL DIAGNOSTICS_FILL(tmp1k,'VVEL_k2 ',0,1,0,1,1,myThid)
114         CALL DIAGNOSTICS_FILL(tmpMk,'VVELSQ  ',0,Nr,0,1,1,myThid)          ENDIF
115        ENDIF        
116    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
117        IF ( DIAGNOSTICS_IS_ON('WVELSQ  ',myThid) ) THEN  
118         DO bj = myByLo(myThid), myByHi(myThid)          IF ( DIAGNOSTICS_IS_ON('UV_VEL_C',myThid) ) THEN
119          DO bi = myBxLo(myThid), myBxHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
120            DO K=1,Nr            DO bi = myBxLo(myThid), myBxHi(myThid)
121               DO K=1,Nr
122                DO j = 1,sNy
123                 DO i = 1,sNx
124                  uBarC = 0.5 _d 0
125         &           *(uVel(i,j,K,bi,bj)+uVel(i+1,j,K,bi,bj))
126                  vBarC = 0.5 _d 0
127         &           *(vVel(i,j,K,bi,bj)+vVel(i,j+1,K,bi,bj))
128                  tmpMk(i,j,K,bi,bj) =
129         &            ( angleCosC(i,j,bi,bj)*uBarC
130         &             -angleSinC(i,j,bi,bj)*vBarC )
131         &           *( angleSinC(i,j,bi,bj)*uBarC
132         &             +angleCosC(i,j,bi,bj)*vBarC )
133                 ENDDO
134                ENDDO
135               ENDDO
136              ENDDO
137             ENDDO
138             CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_C',0,Nr,0,1,1,myThid)
139            ENDIF
140          
141            IF ( DIAGNOSTICS_IS_ON('UV_VEL_Z',myThid) ) THEN
142             DO bj = myByLo(myThid), myByHi(myThid)
143              DO bi = myBxLo(myThid), myBxHi(myThid)
144               DO K=1,Nr
145                DO j = 1,sNy+1
146                 DO i = 1,sNx+1
147                  tmpMk(i,j,K,bi,bj) = 0.25 _d 0
148         &           *(uVel(i,j-1,K,bi,bj)+uVel(i,j,K,bi,bj))
149         &           *(vVel(i-1,j,K,bi,bj)+vVel(i,j,K,bi,bj))
150                 ENDDO
151                ENDDO
152               ENDDO
153              ENDDO
154             ENDDO
155             CALL DIAGNOSTICS_FILL(tmpMk,'UV_VEL_Z',0,Nr,0,1,1,myThid)
156            ENDIF
157          
158            IF ( DIAGNOSTICS_IS_ON('WU_VEL  ',myThid) ) THEN
159             DO bj = myByLo(myThid), myByHi(myThid)
160              DO bi = myBxLo(myThid), myBxHi(myThid)
161               DO K=1,Nr
162                km1 = MAX(k-1,1)
163              DO j = 1,sNy              DO j = 1,sNy
164                DO i = 1,sNx               DO i = 1,sNx+1
165                  tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*wVel(i,j,K,bi,bj)                tmpMk(i,j,K,bi,bj) = 0.25 _d 0
166                ENDDO       &           *(uVel(i,j,km1,bi,bj)+uVel(i,j,K,bi,bj))
167              ENDDO       &           *(wVel(i-1,j,K,bi,bj)*rA(i-1,j,bi,bj)
168            ENDDO       &            +wVel( i ,j,K,bi,bj)*rA( i ,j,bi,bj)
169          ENDDO       &            )*recip_rAw(i,j,bi,bj)
170         ENDDO               ENDDO
171         CALL DIAGNOSTICS_FILL(tmpMk,'WVELSQ  ',0,Nr,0,1,1,myThid)              ENDDO
172        ENDIF             ENDDO
173                    ENDDO
174        IF ( DIAGNOSTICS_IS_ON('THETASQ ',myThid) ) THEN           ENDDO
175         DO bj = myByLo(myThid), myByHi(myThid)           CALL DIAGNOSTICS_FILL(tmpMk,'WU_VEL  ',0,Nr,0,1,1,myThid)
176          DO bi = myBxLo(myThid), myBxHi(myThid)          ENDIF
177            DO K=1,Nr  
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              DO j = 1,sNy
205                DO i = 1,sNx               DO i = 1,sNx+1
206                  tmpMk(i,j,K,bi,bj)                 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,j,K,bi,bj)       &                  *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))
208                ENDDO               ENDDO
209              ENDDO              ENDDO
210               ENDDO
211            ENDDO            ENDDO
212          ENDDO           ENDDO
213         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'UVELTH  ',0,Nr,0,1,1,myThid)
214         CALL DIAGNOSTICS_FILL(tmpMk,'THETASQ ',0,Nr,0,1,1,myThid)          ENDIF
215        ENDIF        
216                  IF ( DIAGNOSTICS_IS_ON('VVELTH  ',myThid) ) THEN
217        IF ( DIAGNOSTICS_IS_ON('SALTSQ  ',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
218         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
219          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
220            DO K=1,Nr              DO j = 1,sNy+1
221              DO j = 1,sNy               DO i = 1,sNx
222                DO i = 1,sNx                 tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
223                  tmpMk(i,j,K,bi,bj) = salt(i,j,K,bi,bj)*salt(i,j,K,bi,bj)       &                  *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))
224                ENDDO               ENDDO
225              ENDDO              ENDDO
226               ENDDO
227            ENDDO            ENDDO
228          ENDDO           ENDDO
229         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'VVELTH  ',0,Nr,0,1,1,myThid)
230         CALL DIAGNOSTICS_FILL(tmpMk,'SALTSQ  ',0,Nr,0,1,1,myThid)          ENDIF
231        ENDIF        
232                  IF ( DIAGNOSTICS_IS_ON('WVELTH  ',myThid) ) THEN
233        IF ( DIAGNOSTICS_IS_ON('UVELVVEL',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
234         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
235          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
236            DO K=1,Nr              km1 = MAX(k-1,1)
237              DO j = 1,sNy              DO j = 1,sNy
238                DO i = 1,sNx               DO i = 1,sNx
239                  tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*vVel(i,j,K,bi,bj)                 tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
240                ENDDO       &                  *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))
241                 ENDDO
242              ENDDO              ENDDO
243               ENDDO
244            ENDDO            ENDDO
245          ENDDO           ENDDO
246         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'WVELTH  ',0,Nr,0,1,1,myThid)
247         CALL DIAGNOSTICS_FILL(tmpMk,'UVELVVEL',0,Nr,0,1,1,myThid)          ENDIF
       ENDIF  
248                
249        IF ( DIAGNOSTICS_IS_ON('UVELTH  ',myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON('UVELSLT ',myThid) ) THEN
250         DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
251          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
252            DO K=1,Nr             DO K=1,Nr
253              DO j = 1,sNy              DO j = 1,sNy
254                DO i = 1,sNx               DO i = 1,sNx+1
255                  tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0                 tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0
256       &                  *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))       &                  *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))
257                ENDDO               ENDDO
258              ENDDO              ENDDO
259               ENDDO
260            ENDDO            ENDDO
261          ENDDO           ENDDO
262         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'UVELSLT ',0,Nr,0,1,1,myThid)
263         CALL DIAGNOSTICS_FILL(tmpMk,'UVELTH  ',0,Nr,0,1,1,myThid)          ENDIF
264        ENDIF        
265                  IF ( DIAGNOSTICS_IS_ON('VVELSLT ',myThid) ) THEN
266        IF ( DIAGNOSTICS_IS_ON('VVELTH  ',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
267         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
268          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
269            DO K=1,Nr              DO j = 1,sNy+1
270              DO j = 1,sNy               DO i = 1,sNx
271                DO i = 1,sNx                 tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
272                  tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0       &                  *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))
273       &                  *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))               ENDDO
               ENDDO  
274              ENDDO              ENDDO
275               ENDDO
276            ENDDO            ENDDO
277          ENDDO           ENDDO
278         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'VVELSLT ',0,Nr,0,1,1,myThid)
279         CALL DIAGNOSTICS_FILL(tmpMk,'VVELTH  ',0,Nr,0,1,1,myThid)          ENDIF
280        ENDIF  
281                  IF ( DIAGNOSTICS_IS_ON('WVELSLT ',myThid) ) THEN
282        IF ( DIAGNOSTICS_IS_ON('WVELTH  ',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
283         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
284          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
           DO K=1,Nr  
285              km1 = MAX(k-1,1)              km1 = MAX(k-1,1)
286              DO j = 1,sNy              DO j = 1,sNy
287                DO i = 1,sNx               DO i = 1,sNx
288                  tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0                 tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
289       &                  *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))       &                  *(salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))
290                ENDDO               ENDDO
291              ENDDO              ENDDO
292               ENDDO
293            ENDDO            ENDDO
294          ENDDO           ENDDO
295         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'WVELSLT ',0,Nr,0,1,1,myThid)
296         CALL DIAGNOSTICS_FILL(tmpMk,'WVELTH  ',0,Nr,0,1,1,myThid)          ENDIF
297        ENDIF        
298                  IF ( DIAGNOSTICS_IS_ON('PRESSURE',myThid) ) THEN
299        IF ( DIAGNOSTICS_IS_ON('UVELSLT ',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
300         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
301          DO bi = myBxLo(myThid), myBxHi(myThid)             do j = 1,sNy
302            DO K=1,Nr             do i = 1,sNx
303              DO j = 1,sNy              do K = 1,Nr
304                DO i = 1,sNx               tmpMk1(i,j,K,bi,bj) = 0.
305                  tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0              enddo
306       &                  *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))             enddo
307                ENDDO             enddo
308               do j = 1,sNy
309               do i = 1,sNx
310                if(ksurfC(i,j,bi,bj).ne.0.)
311         .          tmpMk1(i,j,ksurfC(i,j,bi,bj),bi,bj) =
312         .                            (Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj))
313               enddo
314               enddo
315               do j = 1,sNy
316               do i = 1,sNx
317                do K = ksurfC(i,j,bi,bj)+1,Nr+1
318                 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
325               enddo
326               enddo
327              ENDDO
328             ENDDO
329             CALL DIAGNOSTICS_FILL(tmpMk,'PRESSURE',0,Nr,0,1,1,myThid)
330            ENDIF
331    
332    C--   fill momentum state-var diagnostics: end
333          ENDIF
334    
335    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
336    
337          IF ( selectVars.EQ.1 .OR. selectVars.EQ.3 ) THEN
338    C--   fill tracer state-var diagnostics:
339    
340            CALL DIAGNOSTICS_FILL(theta,'THETA   ',0,Nr,0,1,1,myThid)
341            CALL DIAGNOSTICS_FILL(salt, 'SALT    ',0,Nr,0,1,1,myThid)
342    
343    #ifdef ALLOW_FIZHI
344          IF((useFIZHI).and.(DIAGNOSTICS_IS_ON('RELHUM  ',myThid)))THEN
345           kappa = getcon('KAPPA')
346           do bj = myByLo(myThid), myByHi(myThid)
347           do bi = myBxLo(myThid), myBxHi(myThid)
348            do j = 1,sNy
349             do i = 1,sNx
350              do K = 1,Nr
351               dummy1 = theta(i,j,k,bi,bj) * ((rc(k)/100.)/1000.)**kappa
352               dummy2 = rc(k) / 100.
353               call qsat(dummy1,dummy2,dummy3,dummy4,.false.)
354               tmpMk(i,j,K,bi,bj) = hfacC(i,j,K,bi,bj) *
355         .                    salt(i,j,k,bi,bj) * 100. / dummy3
356               if(k.lt.4) print *,' Temp ',dummy1,' Pres ',dummy2,' q ',
357         .      salt(i,j,k,bi,bj),' qstar ',dummy3,' rh ',tmpMk(i,j,K,bi,bj)
358              enddo
359             enddo
360            enddo
361           enddo
362           enddo
363           CALL DIAGNOSTICS_FILL(tmpMk, 'RELHUM  ',0,Nr,0,1,1,myThid)
364          ENDIF
365    #endif /* ALLOW_FIZHI */
366    
367            CALL DIAGNOSTICS_SCALE_FILL(theta,tmpFac,2,
368         &                              'THETASQ ',0,Nr,0,1,1,myThid)
369            CALL DIAGNOSTICS_SCALE_FILL(salt,tmpFac,2,
370         &                              'SALTSQ  ',0,Nr,0,1,1,myThid)
371          
372            IF ( DIAGNOSTICS_IS_ON('SST     ',myThid) ) THEN
373             DO bj = myByLo(myThid), myByHi(myThid)
374              DO bi = myBxLo(myThid), myBxHi(myThid)
375               DO j = 1,sNy
376                DO i = 1,sNx
377                  tmp1k(i,j,bi,bj) = THETA(i,j,1,bi,bj)
378              ENDDO              ENDDO
379               ENDDO
380            ENDDO            ENDDO
381          ENDDO           ENDDO
382         ENDDO           CALL DIAGNOSTICS_FILL(tmp1k,'SST     ',0,1,0,1,1,myThid)
383         CALL DIAGNOSTICS_FILL(tmpMk,'UVELSLT ',0,Nr,0,1,1,myThid)          ENDIF
384        ENDIF        
385                  IF ( DIAGNOSTICS_IS_ON('SSS     ',myThid) ) THEN
386        IF ( DIAGNOSTICS_IS_ON('VVELSLT ',myThid) ) THEN           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)
               DO i = 1,sNx  
                 tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0  
      &                  *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))  
               ENDDO  
391              ENDDO              ENDDO
392               ENDDO
393            ENDDO            ENDDO
394          ENDDO           ENDDO
395         ENDDO           CALL DIAGNOSTICS_FILL(tmp1k,'SSS     ',0,1,0,1,1,myThid)
396         CALL DIAGNOSTICS_FILL(tmpMk,'VVELSLT ',0,Nr,0,1,1,myThid)          ENDIF
       ENDIF  
397    
398        IF ( DIAGNOSTICS_IS_ON('WVELSLT ',myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON('SALTanom',myThid) ) THEN
399         DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
400          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
401            DO K=1,Nr             DO K=1,Nr
             km1 = MAX(k-1,1)  
402              DO j = 1,sNy              DO j = 1,sNy
403                DO i = 1,sNx               DO i = 1,sNx
404                  tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0                 tmpMk(i,j,K,bi,bj) = salt(i,j,K,bi,bj)-35
405       &                  *(salt(i,j,K,bi,bj)+salt(i,j,km1,bi,bj))               ENDDO
               ENDDO  
406              ENDDO              ENDDO
407               ENDDO
408            ENDDO            ENDDO
409          ENDDO           ENDDO
410         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'SALTanom',0,Nr,0,1,1,myThid)
411         CALL DIAGNOSTICS_FILL(tmpMk,'WVELSLT ',0,Nr,0,1,1,myThid)          ENDIF
       ENDIF  
412                
413        IF ( DIAGNOSTICS_IS_ON('UVELMASS',myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON('SALTSQan',myThid) ) THEN
414         DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
415          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
416            DO K=1,Nr             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              DO j = 1,sNy
436                DO i = 1,sNx                DO i = 1,sNx
437                  tmpMk(i,j,K,bi,bj)                  tmpMk(i,j,K,bi,bj)
438       &               = uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj)       &               = uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj)
439                ENDDO                ENDDO
440              ENDDO              ENDDO
441               ENDDO
442            ENDDO            ENDDO
443          ENDDO           ENDDO
444         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'UVELMASS',0,Nr,0,1,1,myThid)
445         CALL DIAGNOSTICS_FILL(tmpMk,'UVELMASS',0,Nr,0,1,1,myThid)          ENDIF
446        ENDIF  
447            IF ( DIAGNOSTICS_IS_ON('VVELMASS',myThid) ) THEN
448        IF ( DIAGNOSTICS_IS_ON('VVELMASS',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
449         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
450          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
           DO K=1,Nr  
451              DO j = 1,sNy              DO j = 1,sNy
452                DO i = 1,sNx                DO i = 1,sNx
453                  tmpMk(i,j,K,bi,bj)                  tmpMk(i,j,K,bi,bj)
454       &               = vVel(i,j,K,bi,bj)*hFacS(i,j,K,bi,bj)       &               = vVel(i,j,K,bi,bj)*hFacS(i,j,K,bi,bj)
455                ENDDO                ENDDO
456              ENDDO              ENDDO
457               ENDDO
458            ENDDO            ENDDO
459          ENDDO           ENDDO
460         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'VVELMASS',0,Nr,0,1,1,myThid)
461         CALL DIAGNOSTICS_FILL(tmpMk,'VVELMASS',0,Nr,0,1,1,myThid)          ENDIF
       ENDIF  
462    
463        IF ( DIAGNOSTICS_IS_ON('UTHMASS ',myThid) ) THEN          CALL DIAGNOSTICS_FILL(wVel, 'WVELMASS',0,Nr,0,1,1,myThid)
464         DO bj = myByLo(myThid), myByHi(myThid)  
465          DO bi = myBxLo(myThid), myBxHi(myThid)          IF ( DIAGNOSTICS_IS_ON('UTHMASS ',myThid) ) THEN
466            DO K=1,Nr           DO bj = myByLo(myThid), myByHi(myThid)
467              DO bi = myBxLo(myThid), myBxHi(myThid)
468               DO K=1,Nr
469              DO j = 1,sNy              DO j = 1,sNy
470                DO i = 1,sNx               DO i = 1,sNx+1
471                  tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0                 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))       &                  *(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))
473       &                  * hFacW(i,j,K,bi,bj)       &                  * hFacW(i,j,K,bi,bj)
474                ENDDO               ENDDO
475              ENDDO              ENDDO
476               ENDDO
477            ENDDO            ENDDO
478          ENDDO           ENDDO
479         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'UTHMASS ',0,Nr,0,1,1,myThid)
480         CALL DIAGNOSTICS_FILL(tmpMk,'UTHMASS ',0,Nr,0,1,1,myThid)          ENDIF
481        ENDIF  
482            IF ( DIAGNOSTICS_IS_ON('VTHMASS ',myThid) ) THEN
483        IF ( DIAGNOSTICS_IS_ON('VTHMASS ',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
484         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
485          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
486            DO K=1,Nr              DO j = 1,sNy+1
487              DO j = 1,sNy               DO i = 1,sNx
488                DO i = 1,sNx                 tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0
                 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))       &                  *(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))
490       &                  * hFacS(i,j,K,bi,bj)       &                  * hFacS(i,j,K,bi,bj)
491                ENDDO               ENDDO
492              ENDDO              ENDDO
493               ENDDO
494            ENDDO            ENDDO
495          ENDDO           ENDDO
496         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'VTHMASS ',0,Nr,0,1,1,myThid)
497         CALL DIAGNOSTICS_FILL(tmpMk,'VTHMASS ',0,Nr,0,1,1,myThid)          ENDIF
498        ENDIF        
499                  IF ( DIAGNOSTICS_IS_ON('WTHMASS ',myThid) ) THEN
500        IF ( DIAGNOSTICS_IS_ON('USLTMASS',myThid) ) THEN           DO bj = myByLo(myThid), myByHi(myThid)
501         DO bj = myByLo(myThid), myByHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
502          DO bi = myBxLo(myThid), myBxHi(myThid)             DO K=1,Nr
503            DO K=1,Nr              km1 = MAX(k-1,1)
504              DO j = 1,sNy              DO j = 1,sNy
505                DO i = 1,sNx               DO i = 1,sNx
506                  tmpMk(i,j,K,bi,bj) = uVel(i,j,K,bi,bj)*0.5 _d 0                 tmpMk(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5 _d 0
507       &                  *(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))       &                  *(theta(i,j,K,bi,bj)+theta(i,j,km1,bi,bj))
508       &                  * hFacW(i,j,K,bi,bj)               ENDDO
               ENDDO  
509              ENDDO              ENDDO
510               ENDDO
511            ENDDO            ENDDO
512          ENDDO           ENDDO
513         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'WTHMASS ',0,Nr,0,1,1,myThid)
514         CALL DIAGNOSTICS_FILL(tmpMk,'USLTMASS',0,Nr,0,1,1,myThid)          ENDIF
       ENDIF  
515    
516        IF ( DIAGNOSTICS_IS_ON('VSLTMASS',myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON('USLTMASS',myThid) ) THEN
517         DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
518          DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
519            DO K=1,Nr             DO K=1,Nr
520              DO j = 1,sNy              DO j = 1,sNy
521                DO i = 1,sNx               DO i = 1,sNx+1
522                  tmpMk(i,j,K,bi,bj) = vVel(i,j,K,bi,bj)*0.5 _d 0                 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))       &                  *(salt(i,j,K,bi,bj)+salt(i,j-1,K,bi,bj))
541       &                  * hFacS(i,j,K,bi,bj)       &                  * hFacS(i,j,K,bi,bj)
542                ENDDO               ENDDO
543              ENDDO              ENDDO
544               ENDDO
545            ENDDO            ENDDO
546          ENDDO           ENDDO
547         ENDDO           CALL DIAGNOSTICS_FILL(tmpMk,'VSLTMASS',0,Nr,0,1,1,myThid)
548         CALL DIAGNOSTICS_FILL(tmpMk,'VSLTMASS',0,Nr,0,1,1,myThid)          ENDIF
549        ENDIF        
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
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22