pkg/ptracers/ptracers_diagnostics_state.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_diagnostics_state.F,v 1.1 2007/06/21 00:32:21 jmc Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 1
C     !ROUTINE: PTRACERS_DIAGNOSTICS_STATE

C     !INTERFACE:
      SUBROUTINE PTRACERS_DIAGNOSTICS_STATE(myThid)

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

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS_PARAMS.h"
#include "PTRACERS_FIELDS.h"

C     !INPUT PARAMETERS:
      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,N
      CHARACTER*8 diagName
      INTEGER km1

      diagName = '        '

c     DO N = 1,PTRACERS_numInUse
C-    due to format (I2) and diagnostics name limitation,
C      => do not go beyong 99 tracers
      DO N = 1,MIN(99,PTRACERS_numInUse)

        diagName = '        '
        WRITE(diagName,'(A4,I2.2)') 'TRAC',N
        CALL DIAGNOSTICS_FILL( pTracer(1-Olx,1-Oly,1,1,1,N), diagName,
     &                         0,Nr,0,1,1,myThid )

        diagName = '        '
        WRITE(diagName,'(A5,I2.2)') 'UTRAC',N
        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
                  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,N)
     &                       + pTracer(i-1,j,k,bi,bj,N))
                ENDDO
              ENDDO
            ENDDO
          ENDDO
         ENDDO
         CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
        ENDIF

        diagName = '        '
        WRITE(diagName,'(A5,I2.2)') 'VTRAC',N
        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
                  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,N)
     &                       + pTracer(i,j-1,k,bi,bj,N))
                ENDDO
              ENDDO
            ENDDO
          ENDDO
         ENDDO
         CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
        ENDIF

        diagName = '        '
        WRITE(diagName,'(A5,I2.2)') 'WTRAC',N
        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
                  dummy(i,j,k,bi,bj) = wVel(i,j,k,bi,bj) *
     &                 0.5 _d 0*(pTracer(i,j,k,bi,bj,N)
     &                       + pTracer(i,j,km1,bi,bj,N))
                ENDDO
              ENDDO
            ENDDO
          ENDDO
         ENDDO
         CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
        ENDIF

      ENDDO

#endif /* ALLOW_DIAGNOSTICS */

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
1	jmc	1.2	C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_diagnostics_state.F,v 1.1 2007/06/21 00:32:21 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "PTRACERS_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7			CBOP 1
8			C !ROUTINE: PTRACERS_DIAGNOSTICS_STATE
9
10			C !INTERFACE:
11			SUBROUTINE PTRACERS_DIAGNOSTICS_STATE(myThid)
12
13			C !DESCRIPTION:
14			C Fill-in the diagnostics array for PTRACERS state variables
15	jmc	1.2
16	jmc	1.1	C !USES:
17			IMPLICIT NONE
18			#include "SIZE.h"
19			#include "EEPARAMS.h"
20			#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	jmc	1.1
26			C !INPUT PARAMETERS:
27	jmc	1.2	INTEGER myThid
28	jmc	1.1	CEOP
29
30			#ifdef ALLOW_DIAGNOSTICS
31
32			C !LOCAL VARIABLES:
33			LOGICAL DIAGNOSTICS_IS_ON
34			EXTERNAL DIAGNOSTICS_IS_ON
35	jmc	1.2	_RL dummy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
36			INTEGER i,j,k,bi,bj,N
37			CHARACTER*8 diagName
38	jmc	1.1	INTEGER km1
39	jmc	1.2
40			diagName = ' '
41
42	jmc	1.1	c DO N = 1,PTRACERS_numInUse
43	jmc	1.2	C- due to format (I2) and diagnostics name limitation,
44	jmc	1.1	C => do not go beyong 99 tracers
45			DO N = 1,MIN(99,PTRACERS_numInUse)
46	jmc	1.2
47			diagName = ' '
48			WRITE(diagName,'(A4,I2.2)') 'TRAC',N
49			CALL DIAGNOSTICS_FILL( pTracer(1-Olx,1-Oly,1,1,1,N), diagName,
50	jmc	1.1	& 0,Nr,0,1,1,myThid )
51	jmc	1.2
52			diagName = ' '
53			WRITE(diagName,'(A5,I2.2)') 'UTRAC',N
54			IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
55	jmc	1.1	DO bj = myByLo(myThid), myByHi(myThid)
56			DO bi = myBxLo(myThid), myBxHi(myThid)
57	jmc	1.2	DO k=1,Nr
58	jmc	1.1	DO j = 1,sNy
59	jmc	1.2	DO i = 1,sNx+1
60			dummy(i,j,k,bi,bj) =
61			& uVel(i,j,k,bi,bj)hFacW(i,j,k,bi,bj)
62			& 0.5 _d 0*(pTracer(i,j,k,bi,bj,N)
63			& + pTracer(i-1,j,k,bi,bj,N))
64	jmc	1.1	ENDDO
65			ENDDO
66			ENDDO
67			ENDDO
68			ENDDO
69	jmc	1.2	CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
70	jmc	1.1	ENDIF
71	jmc	1.2
72			diagName = ' '
73			WRITE(diagName,'(A5,I2.2)') 'VTRAC',N
74			IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
75	jmc	1.1	DO bj = myByLo(myThid), myByHi(myThid)
76			DO bi = myBxLo(myThid), myBxHi(myThid)
77	jmc	1.2	DO k=1,Nr
78			DO j = 1,sNy+1
79	jmc	1.1	DO i = 1,sNx
80	jmc	1.2	dummy(i,j,k,bi,bj) =
81			& vVel(i,j,k,bi,bj)hFacS(i,j,k,bi,bj)
82			& 0.5 _d 0*(pTracer(i,j,k,bi,bj,N)
83			& + pTracer(i,j-1,k,bi,bj,N))
84	jmc	1.1	ENDDO
85			ENDDO
86			ENDDO
87			ENDDO
88			ENDDO
89	jmc	1.2	CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
90	jmc	1.1	ENDIF
91	jmc	1.2
92			diagName = ' '
93			WRITE(diagName,'(A5,I2.2)') 'WTRAC',N
94			IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
95	jmc	1.1	DO bj = myByLo(myThid), myByHi(myThid)
96			DO bi = myBxLo(myThid), myBxHi(myThid)
97	jmc	1.2	DO k=1,Nr
98			km1 = MAX(k-1,1)
99	jmc	1.1	DO j = 1,sNy
100			DO i = 1,sNx
101	jmc	1.2	dummy(i,j,k,bi,bj) = wVel(i,j,k,bi,bj) *
102			& 0.5 _d 0*(pTracer(i,j,k,bi,bj,N)
103			& + pTracer(i,j,km1,bi,bj,N))
104	jmc	1.1	ENDDO
105			ENDDO
106			ENDDO
107			ENDDO
108			ENDDO
109	jmc	1.2	CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
110	jmc	1.1	ENDIF
111	jmc	1.2
112	jmc	1.1	ENDDO
113
114			#endif /* ALLOW_DIAGNOSTICS */
115
116	jmc	1.2	RETURN
117	jmc	1.1	END
118
119			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|