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