C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_diagnostics_state.F,v 1.6 2010/03/16 00:22:26 jmc 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
_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 do not 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 do not 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 do not 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-|--+----|