pkg/ptracers/ptracers_diagnostics_state.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_diagnostics_state.F,v 1.4 2009/06/26 23:10:10 jahn Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

CBOP 1
C     !ROUTINE: PTRACERS_DIAGNOSTICS_STATE

C     !INTERFACE:
      SUBROUTINE PTRACERS_DIAGNOSTICS_STATE(myTime, myIter, myThid)

C     !DESCRIPTION:
C     Fill-in the diagnostics array for PTRACERS state variables

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#include "PTRACERS_FIELDS.h"
#ifdef ALLOW_LONGSTEP
#include "LONGSTEP.h"
#endif

C     !INPUT PARAMETERS:
      _RL     myTime
      INTEGER myIter
      INTEGER myThid
CEOP

#ifdef ALLOW_DIAGNOSTICS

C     !LOCAL VARIABLES:
      LOGICAL  DIAGNOSTICS_IS_ON
      EXTERNAL DIAGNOSTICS_IS_ON
      _RL dummy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
      INTEGER i,j,k,bi,bj,iTr
      CHARACTER*8 diagName
      INTEGER km1
#ifdef ALLOW_LONGSTEP
      INTEGER trIter
#endif

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

#ifdef ALLOW_LONGSTEP
C     fill only once every long time step
C     have to treat first time step by hand...
C     trIter=0 when this routine is called the first time
      IF ( staggerTimeStep ) THEN
        trIter = myIter-1
      ELSE
        trIter = myIter
      ENDIF
      IF ( LS_doTimeStep .OR. trIter.EQ.nIter0 ) THEN
#else
      IF ( .TRUE. ) THEN
#endif

       diagName = '        '

       DO iTr = 1,PTRACERS_numInUse

        diagName = '        '
        WRITE(diagName,'(A4,A2)') 'TRAC',PTRACERS_ioLabel(iTr)
        CALL DIAGNOSTICS_FILL( pTracer(1-Olx,1-Oly,1,1,1,iTr), diagName,
     &                         0,Nr,0,1,1,myThid )

        diagName = '        '
        WRITE(diagName,'(A5,A2)') 'UTRAC',PTRACERS_ioLabel(iTr)
        IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            DO k=1,Nr
              DO j = 1,sNy
                DO i = 1,sNx+1
#ifdef ALLOW_LONGSTEP
C     at first timestep we don't have averaged velocities yet -
C     use initial velocities instead
                 IF ( trIter.GT.nIter0 ) THEN
                  dummy(i,j,k,bi,bj) =
     &                 LS_uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj) *
     &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
     &                          + pTracer(i-1,j,k,bi,bj,iTr) )
                 ELSE
#else
                 IF (.TRUE.) THEN
#endif
                  dummy(i,j,k,bi,bj) =
     &                 uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj) *
     &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
     &                          + pTracer(i-1,j,k,bi,bj,iTr) )
                 ENDIF
                ENDDO
              ENDDO
            ENDDO
          ENDDO
         ENDDO
         CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
        ENDIF

        diagName = '        '
        WRITE(diagName,'(A5,A2)') 'VTRAC',PTRACERS_ioLabel(iTr)
        IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            DO k=1,Nr
              DO j = 1,sNy+1
                DO i = 1,sNx
#ifdef ALLOW_LONGSTEP
C     at first timestep we don't have averaged velocities yet -
C     use initial velocities instead
                 IF ( trIter.GT.nIter0 ) THEN
                  dummy(i,j,k,bi,bj) =
     &                 LS_vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj) *
     &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
     &                          + pTracer(i,j-1,k,bi,bj,iTr) )
                 ELSE
#else
                 IF (.TRUE.) THEN
#endif
                  dummy(i,j,k,bi,bj) =
     &                 vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj) *
     &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
     &                          + pTracer(i,j-1,k,bi,bj,iTr) )
                 ENDIF
                ENDDO
              ENDDO
            ENDDO
          ENDDO
         ENDDO
         CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
        ENDIF

        diagName = '        '
        WRITE(diagName,'(A5,A2)') 'WTRAC',PTRACERS_ioLabel(iTr)
        IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
         DO bj = myByLo(myThid), myByHi(myThid)
          DO bi = myBxLo(myThid), myBxHi(myThid)
            DO k=1,Nr
              km1 = MAX(k-1,1)
              DO j = 1,sNy
                DO i = 1,sNx
#ifdef ALLOW_LONGSTEP
C     at first timestep we don't have averaged velocities yet -
C     use initial velocities instead
                 IF ( trIter.GT.nIter0 ) THEN
                  dummy(i,j,k,bi,bj) = LS_wVel(i,j,k,bi,bj) *
     &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
     &                          + pTracer(i,j,km1,bi,bj,iTr) )
                 ELSE
#else
                 IF (.TRUE.) THEN
#endif
                  dummy(i,j,k,bi,bj) = wVel(i,j,k,bi,bj) *
     &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
     &                          + pTracer(i,j,km1,bi,bj,iTr) )
                 ENDIF
                ENDDO
              ENDDO
            ENDDO
          ENDDO
         ENDDO
         CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
        ENDIF

       ENDDO

C     LS_doTimeStep
      ENDIF

#endif /* ALLOW_DIAGNOSTICS */

      RETURN
      END

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