pkg/ptracers/ptracers_diagnostics_state.F

30049a6c73 Jean*0001 #include "PTRACERS_OPTIONS.h"
                0002
d2825c6d08 Ed H*0003 CBOP 1
c1459692c9 Jean*0004 C     !ROUTINE: PTRACERS_DIAGNOSTICS_STATE
30049a6c73 Jean*0005
d2825c6d08 Ed H*0006 C     !INTERFACE:
4e66ab0b67 Oliv*0007       SUBROUTINE PTRACERS_DIAGNOSTICS_STATE(myTime, myIter, myThid)
d2825c6d08 Ed H*0008
                0009 C     !DESCRIPTION:
c1459692c9 Jean*0010 C     Fill-in the diagnostics array for PTRACERS state variables
03346d7dda Jean*0011
d2825c6d08 Ed H*0012 C     !USES:
2e794ec007 Jean*0013       IMPLICIT NONE
30049a6c73 Jean*0014 #include "SIZE.h"
                0015 #include "EEPARAMS.h"
4e66ab0b67 Oliv*0016 #include "PARAMS.h"
30049a6c73 Jean*0017 #include "GRID.h"
                0018 #include "DYNVARS.h"
636477d15b Jean*0019 #include "PTRACERS_SIZE.h"
03346d7dda Jean*0020 #include "PTRACERS_PARAMS.h"
                0021 #include "PTRACERS_FIELDS.h"
4e66ab0b67 Oliv*0022 #ifdef ALLOW_LONGSTEP
                0023 #include "LONGSTEP.h"
                0024 #endif
30049a6c73 Jean*0025
d2825c6d08 Ed H*0026 C     !INPUT PARAMETERS:
4e66ab0b67 Oliv*0027       _RL     myTime
                0028       INTEGER myIter
03346d7dda Jean*0029       INTEGER myThid
d2825c6d08 Ed H*0030 CEOP
                0031
30049a6c73 Jean*0032 #ifdef ALLOW_DIAGNOSTICS
d2825c6d08 Ed H*0033
                0034 C     !LOCAL VARIABLES:
2e794ec007 Jean*0035       LOGICAL  DIAGNOSTICS_IS_ON
                0036       EXTERNAL DIAGNOSTICS_IS_ON
03346d7dda Jean*0037       _RL dummy(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
01111eb599 Jean*0038       INTEGER i,j,k,bi,bj,iTr
03346d7dda Jean*0039       CHARACTER*8 diagName
30049a6c73 Jean*0040       INTEGER km1
3ab6b68cec Jean*0041 #ifdef ALLOW_LONGSTEP
4e66ab0b67 Oliv*0042       INTEGER trIter
3ab6b68cec Jean*0043 #endif
                0044
                0045 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
4e66ab0b67 Oliv*0046
                0047 #ifdef ALLOW_LONGSTEP
                0048 C     fill only once every long time step
                0049 C     have to treat first time step by hand...
                0050 C     trIter=0 when this routine is called the first time
                0051       IF ( staggerTimeStep ) THEN
                0052         trIter = myIter-1
                0053       ELSE
                0054         trIter = myIter
                0055       ENDIF
                0056       IF ( LS_doTimeStep .OR. trIter.EQ.nIter0 ) THEN
                0057 #else
                0058       IF ( .TRUE. ) THEN
                0059 #endif
                0060
                0061        diagName = '        '
                0062
                0063        DO iTr = 1,PTRACERS_numInUse
03346d7dda Jean*0064
                0065         diagName = '        '
01111eb599 Jean*0066         WRITE(diagName,'(A4,A2)') 'TRAC',PTRACERS_ioLabel(iTr)
                0067         CALL DIAGNOSTICS_FILL( pTracer(1-Olx,1-Oly,1,1,1,iTr), diagName,
2e794ec007 Jean*0068      &                         0,Nr,0,1,1,myThid )
03346d7dda Jean*0069
                0070         diagName = '        '
01111eb599 Jean*0071         WRITE(diagName,'(A5,A2)') 'UTRAC',PTRACERS_ioLabel(iTr)
03346d7dda Jean*0072         IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
2e794ec007 Jean*0073          DO bj = myByLo(myThid), myByHi(myThid)
                0074           DO bi = myBxLo(myThid), myBxHi(myThid)
03346d7dda Jean*0075             DO k=1,Nr
2e794ec007 Jean*0076               DO j = 1,sNy
03346d7dda Jean*0077                 DO i = 1,sNx+1
4e66ab0b67 Oliv*0078 #ifdef ALLOW_LONGSTEP
88f72205aa Jean*0079 C     at first timestep we do not have averaged velocities yet -
4e66ab0b67 Oliv*0080 C     use initial velocities instead
                0081                  IF ( trIter.GT.nIter0 ) THEN
                0082                   dummy(i,j,k,bi,bj) =
                0083      &                 LS_uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj) *
                0084      &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
                0085      &                          + pTracer(i-1,j,k,bi,bj,iTr) )
                0086                  ELSE
                0087 #else
                0088                  IF (.TRUE.) THEN
                0089 #endif
03346d7dda Jean*0090                   dummy(i,j,k,bi,bj) =
                0091      &                 uVel(i,j,k,bi,bj)*hFacW(i,j,k,bi,bj) *
01111eb599 Jean*0092      &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
                0093      &                          + pTracer(i-1,j,k,bi,bj,iTr) )
4e66ab0b67 Oliv*0094                  ENDIF
2e794ec007 Jean*0095                 ENDDO
                0096               ENDDO
                0097             ENDDO
                0098           ENDDO
                0099          ENDDO
03346d7dda Jean*0100          CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
2e794ec007 Jean*0101         ENDIF
03346d7dda Jean*0102
                0103         diagName = '        '
01111eb599 Jean*0104         WRITE(diagName,'(A5,A2)') 'VTRAC',PTRACERS_ioLabel(iTr)
03346d7dda Jean*0105         IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
2e794ec007 Jean*0106          DO bj = myByLo(myThid), myByHi(myThid)
                0107           DO bi = myBxLo(myThid), myBxHi(myThid)
03346d7dda Jean*0108             DO k=1,Nr
                0109               DO j = 1,sNy+1
2e794ec007 Jean*0110                 DO i = 1,sNx
4e66ab0b67 Oliv*0111 #ifdef ALLOW_LONGSTEP
88f72205aa Jean*0112 C     at first timestep we do not have averaged velocities yet -
4e66ab0b67 Oliv*0113 C     use initial velocities instead
                0114                  IF ( trIter.GT.nIter0 ) THEN
                0115                   dummy(i,j,k,bi,bj) =
                0116      &                 LS_vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj) *
                0117      &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
                0118      &                          + pTracer(i,j-1,k,bi,bj,iTr) )
                0119                  ELSE
                0120 #else
                0121                  IF (.TRUE.) THEN
                0122 #endif
03346d7dda Jean*0123                   dummy(i,j,k,bi,bj) =
                0124      &                 vVel(i,j,k,bi,bj)*hFacS(i,j,k,bi,bj) *
01111eb599 Jean*0125      &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
                0126      &                          + pTracer(i,j-1,k,bi,bj,iTr) )
4e66ab0b67 Oliv*0127                  ENDIF
2e794ec007 Jean*0128                 ENDDO
                0129               ENDDO
                0130             ENDDO
                0131           ENDDO
                0132          ENDDO
03346d7dda Jean*0133          CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
2e794ec007 Jean*0134         ENDIF
03346d7dda Jean*0135
                0136         diagName = '        '
01111eb599 Jean*0137         WRITE(diagName,'(A5,A2)') 'WTRAC',PTRACERS_ioLabel(iTr)
03346d7dda Jean*0138         IF ( DIAGNOSTICS_IS_ON(diagName,myThid) ) THEN
2e794ec007 Jean*0139          DO bj = myByLo(myThid), myByHi(myThid)
                0140           DO bi = myBxLo(myThid), myBxHi(myThid)
03346d7dda Jean*0141             DO k=1,Nr
                0142               km1 = MAX(k-1,1)
2e794ec007 Jean*0143               DO j = 1,sNy
                0144                 DO i = 1,sNx
4e66ab0b67 Oliv*0145 #ifdef ALLOW_LONGSTEP
88f72205aa Jean*0146 C     at first timestep we do not have averaged velocities yet -
4e66ab0b67 Oliv*0147 C     use initial velocities instead
                0148                  IF ( trIter.GT.nIter0 ) THEN
                0149                   dummy(i,j,k,bi,bj) = LS_wVel(i,j,k,bi,bj) *
                0150      &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
                0151      &                          + pTracer(i,j,km1,bi,bj,iTr) )
                0152                  ELSE
                0153 #else
                0154                  IF (.TRUE.) THEN
                0155 #endif
03346d7dda Jean*0156                   dummy(i,j,k,bi,bj) = wVel(i,j,k,bi,bj) *
01111eb599 Jean*0157      &                 0.5 _d 0*( pTracer(i,j,k,bi,bj,iTr)
                0158      &                          + pTracer(i,j,km1,bi,bj,iTr) )
4e66ab0b67 Oliv*0159                  ENDIF
2e794ec007 Jean*0160                 ENDDO
                0161               ENDDO
                0162             ENDDO
                0163           ENDDO
                0164          ENDDO
03346d7dda Jean*0165          CALL DIAGNOSTICS_FILL( dummy, diagName, 0,Nr,0,1,1,myThid )
2e794ec007 Jean*0166         ENDIF
03346d7dda Jean*0167
4e66ab0b67 Oliv*0168        ENDDO
                0169
                0170 C     LS_doTimeStep
                0171       ENDIF
d2825c6d08 Ed H*0172
30049a6c73 Jean*0173 #endif /* ALLOW_DIAGNOSTICS */
                0174
03346d7dda Jean*0175       RETURN
2e794ec007 Jean*0176       END
d2825c6d08 Ed H*0177
                0178 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|