/[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.6 by edhill, Wed May 5 00:39:21 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         subroutine diagnostics_fill_state(myThid)  #include "DIAG_OPTIONS.h"
5         implicit none  
6  #include "PACKAGES_CONFIG.h"  CBOP
7    C     !ROUTINE: DIAGNOSTICS_FILL_STATE
8    C     !INTERFACE:
9          SUBROUTINE DIAGNOSTICS_FILL_STATE( selectVars, myThid )
10    
11    C     !DESCRIPTION: \bv
12    C     *==========================================================*
13    C     | SUBROUTINE DIAGNOSTICS_FILL_STATE
14    C     | o Fill-in main code, state-variables diagnostics
15    C     *==========================================================*
16    C     \ev
17    
18    C     !USES:
19          IMPLICIT NONE
20    C     == Global variables ===
21  #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 "DYNVARS.h"  #include "DYNVARS.h"
26  # ifdef ALLOW_PTRACERS  #include "SURFACE.h"
 #  include "PTRACERS.h"  
 # endif  
   
       integer myThid  
       _RL dummy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr,Nsx,Nsy)  
       integer i,j,K,bi,bj  
   
         call fill_diagnostics(myThid,'ETAN    ',0,1,0,1,1,etaN)  
   
         do bj = myByLo(myThid), myByHi(myThid)  
         do bi = myBxLo(myThid), myBxHi(myThid)  
           do j = 1,sNy  
           do i = 1,sNx  
            dummy(i,j,1,bi,bj) = etaN(i,j,bi,bj)*etaN(i,j,bi,bj)  
           enddo  
           enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'ETANSQ  ',0,1,0,1,1,dummy)  
   
         call fill_diagnostics(myThid,'UVEL    ',0,Nr,0,1,1,uVel)  
         call fill_diagnostics(myThid,'VVEL    ',0,Nr,0,1,1,vVel)  
         call fill_diagnostics(myThid,'WVEL    ',0,Nr,0,1,1,wVel)  
         call fill_diagnostics(myThid,'THETA   ',0,Nr,0,1,1,theta)  
         call fill_diagnostics(myThid,'SALT    ',0,Nr,0,1,1,salt)  
   
         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) = uVel(i,j,K,bi,bj)*uVel(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'UVELSQ  ',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)*vVel(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'VVELSQ  ',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) = wVel(i,j,K,bi,bj)*wVel(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'WVELSQ  ',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) = theta(i,j,K,bi,bj)*theta(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'THETASQ ',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) = salt(i,j,K,bi,bj)*salt(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'SALTSQ  ',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) = uVel(i,j,K,bi,bj)*vVel(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'UVELVVEL',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) = uVel(i,j,K,bi,bj)*theta(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'UVELTH  ',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)*theta(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'VVELTH  ',0,Nr,0,1,1,dummy)  
   
         do bj = myByLo(myThid), myByHi(myThid)  
         do bi = myBxLo(myThid), myBxHi(myThid)  
          do K=2,Nr  
           do j = 1,sNy  
           do i = 1,sNx  
            dummy(i,j,K,bi,bj) = 0.  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         do bj = myByLo(myThid), myByHi(myThid)  
         do bi = myBxLo(myThid), myBxHi(myThid)  
          do K=2,Nr  
           do j = 1,sNy  
           do i = 1,sNx  
            dummy(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5*  
      .                 (theta(i,j,K,bi,bj)+theta(i,j,K-1,bi,bj))  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'WVELTH  ',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) = uVel(i,j,K,bi,bj)*salt(i,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)*salt(i,j,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  
           do j = 1,sNy  
           do i = 1,sNx  
            dummy(i,j,K,bi,bj) = wVel(i,j,K,bi,bj)*0.5*  
      .                 (salt(i,j,K,bi,bj)+salt(i,j,K-1,bi,bj))  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'WVELSLT ',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) = uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'UVELMASS',0,Nr,0,1,1,salt)  
   
         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)*hFacS(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'VVELMASS',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) = uVel(i,j,K,bi,bj)*  
      .         0.5*(theta(i,j,K,bi,bj)+theta(i-1,j,K,bi,bj))  
      .                                * hFacW(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'UTHMASS ',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*(theta(i,j,K,bi,bj)+theta(i,j-1,K,bi,bj))  
      .                                * hFacW(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'VTHMASS ',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) = uVel(i,j,K,bi,bj)*  
      .         0.5*(salt(i,j,K,bi,bj)+salt(i-1,j,K,bi,bj))  
      .                                * hFacW(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'USLTMASS',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))  
      .                                * hFacW(i,j,K,bi,bj)  
           enddo  
           enddo  
          enddo  
         enddo  
         enddo  
         call fill_diagnostics(myThid,'VSLTMASS',0,Nr,0,1,1,dummy)  
   
27    
28        return  C     !INPUT/OUTPUT PARAMETERS:
29        end  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
39    C     !LOCAL VARIABLES:
40    C     == Local variables ==
41          LOGICAL  DIAGNOSTICS_IS_ON
42          EXTERNAL DIAGNOSTICS_IS_ON
43          _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)
46          _RL tmpFac, uBarC, vBarC
47          _RL dummy1, dummy2, dummy3, dummy4, kappa, getcon
48          INTEGER i,j,K,bi,bj
49          INTEGER km1
50          
51          tmpFac = 1. _d 0
52    
53          IF ( selectVars .GE. 2 ) THEN
54    C--   fill momentum state-var diagnostics:
55    
56            CALL DIAGNOSTICS_FILL(etaN, 'ETAN    ',0, 1,0,1,1,myThid)
57    
58            IF ( DIAGNOSTICS_IS_ON('RSURF   ',myThid) ) THEN
59             DO bj = myByLo(myThid), myByHi(myThid)
60              DO bi = myBxLo(myThid), myBxHi(myThid)
61               DO j = 1,sNy
62                DO i = 1,sNx
63                  tmp1k(i,j,bi,bj) = Ro_surf(i,j,bi,bj) + etaH(i,j,bi,bj)
64                ENDDO
65               ENDDO
66              ENDDO
67             ENDDO
68             CALL DIAGNOSTICS_FILL(tmp1k,'RSURF   ',0,1,0,1,1,myThid)
69            ENDIF
70    
71            CALL DIAGNOSTICS_SCALE_FILL(etaN,tmpFac,2,
72         &                              'ETANSQ  ',0, 1,0,1,1,myThid)
73          
74    #ifdef EXACT_CONSERV
75            CALL DIAGNOSTICS_SCALE_FILL(dEtaHdt,tmpFac,2,
76         &                              'DETADT2 ',0, 1,0,1,1,myThid)
77    #endif
78          
79            CALL DIAGNOSTICS_FILL(uVel, 'UVEL    ',0,Nr,0,1,1,myThid)
80            CALL DIAGNOSTICS_FILL(vVel, 'VVEL    ',0,Nr,0,1,1,myThid)
81            CALL DIAGNOSTICS_FILL(wVel, 'WVEL    ',0,Nr,0,1,1,myThid)
82          
83            CALL DIAGNOSTICS_SCALE_FILL(uVel,tmpFac,2,
84         &                              'UVELSQ  ',0,Nr,0,1,1,myThid)
85            CALL DIAGNOSTICS_SCALE_FILL(vVel,tmpFac,2,
86         &                              'VVELSQ  ',0,Nr,0,1,1,myThid)
87            CALL DIAGNOSTICS_SCALE_FILL(wVel,tmpFac,2,
88         &                              'WVELSQ  ',0,Nr,0,1,1,myThid)
89    
90            IF ( DIAGNOSTICS_IS_ON('UVEL_k2 ',myThid) ) THEN
91             DO bj = myByLo(myThid), myByHi(myThid)
92              DO bi = myBxLo(myThid), myBxHi(myThid)
93               DO j = 1,sNy
94                DO i = 1,sNx
95                  tmp1k(i,j,bi,bj) = UVEL(i,j,2,bi,bj)
96                ENDDO
97               ENDDO
98              ENDDO
99             ENDDO
100             CALL DIAGNOSTICS_FILL(tmp1k,'UVEL_k2 ',0,1,0,1,1,myThid)
101            ENDIF
102          
103            IF ( DIAGNOSTICS_IS_ON('VVEL_k2 ',myThid) ) THEN
104             DO bj = myByLo(myThid), myByHi(myThid)
105              DO bi = myBxLo(myThid), myBxHi(myThid)
106               DO j = 1,sNy
107                DO i = 1,sNx
108                  tmp1k(i,j,bi,bj) = VVEL(i,j,2,bi,bj)
109                ENDDO
110               ENDDO
111              ENDDO
112             ENDDO
113             CALL DIAGNOSTICS_FILL(tmp1k,'VVEL_k2 ',0,1,0,1,1,myThid)
114            ENDIF
115          
116    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
117    
118            IF ( DIAGNOSTICS_IS_ON('UV_VEL_C',myThid) ) THEN
119             DO bj = myByLo(myThid), myByHi(myThid)
120              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
164                 DO i = 1,sNx+1
165                  tmpMk(i,j,K,bi,bj) = 0.25 _d 0
166         &           *(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         &            +wVel( i ,j,K,bi,bj)*rA( i ,j,bi,bj)
169         &            )*recip_rAw(i,j,bi,bj)
170                 ENDDO
171                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
302               do i = 1,sNx
303                do K = 1,Nr
304                 tmpMk1(i,j,K,bi,bj) = 0.
305                enddo
306               enddo
307               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
379               ENDDO
380              ENDDO
381             ENDDO
382             CALL DIAGNOSTICS_FILL(tmp1k,'SST     ',0,1,0,1,1,myThid)
383            ENDIF
384          
385            IF ( DIAGNOSTICS_IS_ON('SSS     ',myThid) ) THEN
386             DO bj = myByLo(myThid), myByHi(myThid)
387              DO bi = myBxLo(myThid), myBxHi(myThid)
388               DO j = 1,sNy
389                DO i = 1,sNx
390                  tmp1k(i,j,bi,bj) = SALT(i,j,1,bi,bj)
391                ENDDO
392               ENDDO
393              ENDDO
394             ENDDO
395             CALL DIAGNOSTICS_FILL(tmp1k,'SSS     ',0,1,0,1,1,myThid)
396            ENDIF
397    
398            IF ( DIAGNOSTICS_IS_ON('SALTanom',myThid) ) THEN
399             DO bj = myByLo(myThid), myByHi(myThid)
400              DO bi = myBxLo(myThid), myBxHi(myThid)
401               DO K=1,Nr
402                DO j = 1,sNy
403                 DO i = 1,sNx
404                   tmpMk(i,j,K,bi,bj) = salt(i,j,K,bi,bj)-35
405                 ENDDO
406                ENDDO
407               ENDDO
408              ENDDO
409             ENDDO
410             CALL DIAGNOSTICS_FILL(tmpMk,'SALTanom',0,Nr,0,1,1,myThid)
411            ENDIF
412          
413            IF ( DIAGNOSTICS_IS_ON('SALTSQan',myThid) ) THEN
414             DO bj = myByLo(myThid), myByHi(myThid)
415              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 */
571          
572          RETURN
573          END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22