/[MITgcm]/MITgcm/pkg/ptracers/ptracers_diagnostics_state.F
ViewVC logotype

Diff of /MITgcm/pkg/ptracers/ptracers_diagnostics_state.F

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

revision 1.1 by jmc, Thu Jun 21 00:32:21 2007 UTC revision 1.4 by jahn, Fri Jun 26 23:10:10 2009 UTC
# Line 8  CBOP 1 Line 8  CBOP 1
8  C     !ROUTINE: PTRACERS_DIAGNOSTICS_STATE  C     !ROUTINE: PTRACERS_DIAGNOSTICS_STATE
9    
10  C     !INTERFACE:  C     !INTERFACE:
11        SUBROUTINE PTRACERS_DIAGNOSTICS_STATE(myThid)        SUBROUTINE PTRACERS_DIAGNOSTICS_STATE(myTime, myIter, myThid)
12    
13  C     !DESCRIPTION:  C     !DESCRIPTION:
14  C     Fill-in the diagnostics array for PTRACERS state variables  C     Fill-in the diagnostics array for PTRACERS state variables
15          
16  C     !USES:  C     !USES:
17        IMPLICIT NONE        IMPLICIT NONE
18  #include "SIZE.h"  #include "SIZE.h"
19  #include "EEPARAMS.h"  #include "EEPARAMS.h"
20    #include "PARAMS.h"
21  #include "GRID.h"  #include "GRID.h"
22  #include "DYNVARS.h"  #include "DYNVARS.h"
23  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
24  #include "PTRACERS.h"  #include "PTRACERS_PARAMS.h"
25    #include "PTRACERS_FIELDS.h"
26    #ifdef ALLOW_LONGSTEP
27    #include "LONGSTEP.h"
28    #endif
29    
30  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
31        INTEGER myThid        _RL     myTime
32          INTEGER myIter
33          INTEGER myThid
34  CEOP  CEOP
35    
36  #ifdef ALLOW_DIAGNOSTICS  #ifdef ALLOW_DIAGNOSTICS
# Line 31  CEOP Line 38  CEOP
38  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
39        LOGICAL  DIAGNOSTICS_IS_ON        LOGICAL  DIAGNOSTICS_IS_ON
40        EXTERNAL DIAGNOSTICS_IS_ON        EXTERNAL DIAGNOSTICS_IS_ON
41        _RL dummy(1-OLx:sNx+Olx,1-Oly:sNy+Oly,Nr,Nsx,Nsy)        _RL dummy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
42        INTEGER i,j,K,N,bi,bj        INTEGER i,j,k,bi,bj,iTr
43        CHARACTER*8 diagname        CHARACTER*8 diagName
44        INTEGER km1        INTEGER km1
45                INTEGER trIter
46        diagname = '        '  
47          #ifdef ALLOW_LONGSTEP
48  c     DO N = 1,PTRACERS_numInUse  C     fill only once every long time step
49  C-    due to format (I2) and diagnostics name limitation,  C     have to treat first time step by hand...
50  C      => do not go beyong 99 tracers  C     trIter=0 when this routine is called the first time
51        DO N = 1,MIN(99,PTRACERS_numInUse)        IF ( staggerTimeStep ) THEN
52                    trIter = myIter-1
53          diagname = '        '        ELSE
54          WRITE(diagname,'(A4,I2.2)') 'TRAC',N          trIter = myIter
55          CALL DIAGNOSTICS_FILL( ptracer(1-Olx,1-Oly,1,1,1,N), diagname,        ENDIF
56          IF ( LS_doTimeStep .OR. trIter.EQ.nIter0 ) THEN
57    #else
58          IF ( .TRUE. ) THEN
59    #endif
60    
61           diagName = '        '
62    
63           DO iTr = 1,PTRACERS_numInUse
64    
65            diagName = '        '
66            WRITE(diagName,'(A4,A2)') 'TRAC',PTRACERS_ioLabel(iTr)
67            CALL DIAGNOSTICS_FILL( pTracer(1-Olx,1-Oly,1,1,1,iTr), diagName,
68       &                         0,Nr,0,1,1,myThid )       &                         0,Nr,0,1,1,myThid )
69            
70          diagname = '        '          diagName = '        '
71          WRITE(diagname,'(A5,I2.2)') 'UTRAC',N          WRITE(diagName,'(A5,A2)') 'UTRAC',PTRACERS_ioLabel(iTr)
72          IF ( DIAGNOSTICS_IS_ON(diagname,myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
73           DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
74            DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
75              DO K=1,Nr              DO k=1,Nr
76                DO j = 1,sNy                DO j = 1,sNy
77                  DO i = 1,sNx                  DO i = 1,sNx+1
78                    dummy(i,j,K,bi,bj) =  #ifdef ALLOW_LONGSTEP
79       &                 uVel(i,j,K,bi,bj)*hFacW(i,j,K,bi,bj) *  C     at first timestep we don't have averaged velocities yet -
80       &                 0.5 _d 0*(ptracer(i,j,K,bi,bj,N)  C     use initial velocities instead
81       &                       + ptracer(i-1,j,K,bi,bj,N))                   IF ( trIter.GT.nIter0 ) THEN
82                      dummy(i,j,k,bi,bj) =
83         &                 LS_uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj) *
84         &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
85         &                          + pTracer(i-1,j,k,bi,bj,iTr) )
86                     ELSE
87    #else
88                     IF (.TRUE.) THEN
89    #endif
90                      dummy(i,j,k,bi,bj) =
91         &                 uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj) *
92         &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
93         &                          + pTracer(i-1,j,k,bi,bj,iTr) )
94                     ENDIF
95                  ENDDO                  ENDDO
96                ENDDO                ENDDO
97              ENDDO              ENDDO
98            ENDDO            ENDDO
99           ENDDO           ENDDO
100           CALL DIAGNOSTICS_FILL( dummy, diagname, 0,Nr,0,1,1,myThid )           CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
101          ENDIF          ENDIF
102            
103          diagname = '        '          diagName = '        '
104          WRITE(diagname,'(A5,I2.2)') 'VTRAC',N          WRITE(diagName,'(A5,A2)') 'VTRAC',PTRACERS_ioLabel(iTr)
105          IF ( DIAGNOSTICS_IS_ON(diagname,myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
106           DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
107            DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
108              DO K=1,Nr              DO k=1,Nr
109                DO j = 1,sNy                DO j = 1,sNy+1
110                  DO i = 1,sNx                  DO i = 1,sNx
111                    dummy(i,j,K,bi,bj) =  #ifdef ALLOW_LONGSTEP
112       &                 vVel(i,j,K,bi,bj)*hFacS(i,j,K,bi,bj) *  C     at first timestep we don't have averaged velocities yet -
113       &                 0.5 _d 0*(ptracer(i,j,K,bi,bj,N)  C     use initial velocities instead
114       &                       + ptracer(i,j-1,K,bi,bj,N))                   IF ( trIter.GT.nIter0 ) THEN
115                      dummy(i,j,k,bi,bj) =
116         &                 LS_vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj) *
117         &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
118         &                          + pTracer(i,j-1,k,bi,bj,iTr) )
119                     ELSE
120    #else
121                     IF (.TRUE.) THEN
122    #endif
123                      dummy(i,j,k,bi,bj) =
124         &                 vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj) *
125         &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
126         &                          + pTracer(i,j-1,k,bi,bj,iTr) )
127                     ENDIF
128                  ENDDO                  ENDDO
129                ENDDO                ENDDO
130              ENDDO              ENDDO
131            ENDDO            ENDDO
132           ENDDO           ENDDO
133           CALL DIAGNOSTICS_FILL( dummy, diagname, 0,Nr,0,1,1,myThid )           CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
134          ENDIF          ENDIF
135            
136          diagname = '        '          diagName = '        '
137          WRITE(diagname,'(A5,I2.2)') 'WTRAC',N          WRITE(diagName,'(A5,A2)') 'WTRAC',PTRACERS_ioLabel(iTr)
138          IF ( DIAGNOSTICS_IS_ON(diagname,myThid) ) THEN          IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
139           DO bj = myByLo(myThid), myByHi(myThid)           DO bj = myByLo(myThid), myByHi(myThid)
140            DO bi = myBxLo(myThid), myBxHi(myThid)            DO bi = myBxLo(myThid), myBxHi(myThid)
141              DO K=1,Nr              DO k=1,Nr
142                km1 = MAX(K-1,1)                km1 = MAX(k-1,1)
143                DO j = 1,sNy                DO j = 1,sNy
144                  DO i = 1,sNx                  DO i = 1,sNx
145                    dummy(i,j,K,bi,bj) = wVel(i,j,K,bi,bj) *  #ifdef ALLOW_LONGSTEP
146       &                 0.5 _d 0*(ptracer(i,j,K,bi,bj,N)  C     at first timestep we don't have averaged velocities yet -
147       &                       + ptracer(i,j,km1,bi,bj,N))  C     use initial velocities instead
148                     IF ( trIter.GT.nIter0 ) THEN
149                      dummy(i,j,k,bi,bj) = LS_wVel(i,j,k,bi,bj) *
150         &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
151         &                          + pTracer(i,j,km1,bi,bj,iTr) )
152                     ELSE
153    #else
154                     IF (.TRUE.) THEN
155    #endif
156                      dummy(i,j,k,bi,bj) = wVel(i,j,k,bi,bj) *
157         &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
158         &                          + pTracer(i,j,km1,bi,bj,iTr) )
159                     ENDIF
160                  ENDDO                  ENDDO
161                ENDDO                ENDDO
162              ENDDO              ENDDO
163            ENDDO            ENDDO
164           ENDDO           ENDDO
165           CALL DIAGNOSTICS_FILL( dummy, diagname, 0,Nr,0,1,1,myThid )           CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
166          ENDIF          ENDIF
167            
168        ENDDO         ENDDO
169    
170    C     LS_doTimeStep
171          ENDIF
172    
173  #endif /* ALLOW_DIAGNOSTICS */  #endif /* ALLOW_DIAGNOSTICS */
174    
175        RETURN        RETURN
176        END        END
177    
178  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22