pkg/ptracers/ptracers_write_state.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_write_state.F,v 1.16 2006/10/26 00:29:33 jmc Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

CBOP
C     !ROUTINE: PTRACERS_WRITE_STATE

C     !INTERFACE:
      SUBROUTINE PTRACERS_WRITE_STATE(
     I     myIter, myTime, myThid )

C     !DESCRIPTION:
C     dump to files current passive tracer state

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS.h"

C     !INPUT PARAMETERS:
C     myIter    :: time-step number
C     myTime    :: model time
C     myThid    :: thread number
      INTEGER myIter
      _RL myTime
      INTEGER myThid
CEOP

#ifdef ALLOW_PTRACERS

C     === Functions ====
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE
      INTEGER  IO_ERRCOUNT
      EXTERNAL IO_ERRCOUNT

C     !LOCAL VARIABLES:
C     iTracer   :: loop indices
C     suff      :: character buffer for creating suffix in filename
C     iRec      :: record number
      INTEGER iTracer
      CHARACTER*(MAX_LEN_MBUF) suff
      INTEGER iRec
#ifdef ALLOW_MNC
      CHARACTER*(1) pf
#endif

      IF ( DIFFERENT_MULTIPLE( PTRACERS_dumpFreq, myTime, deltaTClock )
     &  .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
     &                             myTime.EQ.startTime  )
     &   ) THEN

C--   Write to files
       _BARRIER

#ifdef ALLOW_MNC
        IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
          pf(1:1) = 'D'
        ELSE
          pf(1:1) = 'R'
        ENDIF

       IF ( PTRACERS_snapshot_mnc ) THEN
        CALL MNC_CW_SET_UDIM('ptracers', -1, myThid)
        CALL MNC_CW_RL_W_S('D','ptracers',0,0,'T',myTime,myThid)
        CALL MNC_CW_SET_UDIM('ptracers', 0, myThid)
        CALL MNC_CW_I_W_S('I','ptracers',0,0,'iter',myIter,myThid)
        DO iTracer = 1,PTRACERS_numInUse
         CALL MNC_CW_RL_W(pf,'ptracers',0,0,PTRACERS_names(iTracer),
     &        pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)
        ENDDO
       ENDIF
#endif /*  ALLOW_MNC  */

       IF ( PTRACERS_snapshot_mdsio ) THEN

C       Loop over tracers
        DO iTracer=1,PTRACERS_numInUse

#ifdef MULTIPLE_RECORD_STATE_FILES
C     Write each snap-shot as a record in a time-history file
         IF (PTRACERS_useRecords) THEN
C     Write each passive tracer as a record
          WRITE(suff,'(A)') 'PTRACERS'
          iRec = 1 + NINT( (myTime-startTime) / PTRACERS_dumpFreq )
          iRec = (iRec-1)*PTRACERS_num + iTracer + 1
         ELSE
C     Write each passive tracer in its own file
          WRITE(pref,'(A7,I2.2)') 'PTRACER',iTracer
          iRec = 1 + NINT( (myTime-startTime) / PTRACERS_dumpFreq )
         ENDIF
#else
C         Write each snap-shot as a new file with a 10-digit suffix to
C     indicate time-step number
         IF (PTRACERS_useRecords) THEN
C     Write each passive tracer as a record
          WRITE(suff,'(A,I10.10)') 'PTRACERS',myIter
          iRec=iTracer
         ELSE
C     Write each passive tracer in its own file
          WRITE(suff,'(A7,I2.2,A1,I10.10)')
     &         'PTRACER',iTracer,'.',myIter
          iRec=1
         ENDIF
#endif /* MULTIPLE_RECORD_STATE_FILES */

         CALL WRITE_REC_XYZ_RL(suff,
     &        pTracer(1-Olx,1-Oly,1,1,1,iTracer),iRec,myIter,myThid)

C     End of tracer loop
        ENDDO

       ENDIF

       _BARRIER
C--   Writing to files: end
      ENDIF

#endif /* ALLOW_PTRACERS */

      RETURN
      END
1	jmc	1.17	C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_write_state.F,v 1.16 2006/10/26 00:29:33 jmc Exp $
2	dimitri	1.2	C $Name: $
3	adcroft	1.1
4			#include "PTRACERS_OPTIONS.h"
5
6			CBOP
7	edhill	1.4	C !ROUTINE: PTRACERS_WRITE_STATE
8	adcroft	1.1
9	edhill	1.4	C !INTERFACE:
10	jmc	1.16	SUBROUTINE PTRACERS_WRITE_STATE(
11	mlosch	1.8	I myIter, myTime, myThid )
12	adcroft	1.1
13	edhill	1.4	C !DESCRIPTION:
14	jmc	1.17	C dump to files current passive tracer state
15	adcroft	1.1
16	edhill	1.4	C !USES:
17	adcroft	1.1	IMPLICIT NONE
18			#include "SIZE.h"
19			#include "EEPARAMS.h"
20	edhill	1.4	#include "PARAMS.h"
21	jmc	1.3	#include "PTRACERS_SIZE.h"
22	adcroft	1.1	#include "PTRACERS.h"
23
24	edhill	1.4	C !INPUT PARAMETERS:
25			C myIter :: time-step number
26			C myTime :: model time
27			C myThid :: thread number
28	adcroft	1.1	INTEGER myIter
29			_RL myTime
30			INTEGER myThid
31	edhill	1.4	CEOP
32	adcroft	1.1
33			#ifdef ALLOW_PTRACERS
34
35	jmc	1.16	C === Functions ====
36			LOGICAL DIFFERENT_MULTIPLE
37			EXTERNAL DIFFERENT_MULTIPLE
38			INTEGER IO_ERRCOUNT
39			EXTERNAL IO_ERRCOUNT
40
41	edhill	1.4	C !LOCAL VARIABLES:
42			C iTracer :: loop indices
43			C suff :: character buffer for creating suffix in filename
44			C iRec :: record number
45	adcroft	1.1	INTEGER iTracer
46			CHARACTER*(MAX_LEN_MBUF) suff
47			INTEGER iRec
48	jmc	1.16	#ifdef ALLOW_MNC
49	edhill	1.15	CHARACTER*(1) pf
50	jmc	1.16	#endif
51	mlosch	1.8
52	jmc	1.11	IF ( DIFFERENT_MULTIPLE( PTRACERS_dumpFreq, myTime, deltaTClock )
53	jmc	1.14	& .OR. dumpInitAndLast.AND.( myTime.EQ.endTime .OR.
54			& myTime.EQ.startTime )
55	jmc	1.11	& ) THEN
56	jmc	1.16
57			C-- Write to files
58			_BARRIER
59
60			#ifdef ALLOW_MNC
61	edhill	1.15	IF ( writeBinaryPrec .EQ. precFloat64 ) THEN
62			pf(1:1) = 'D'
63			ELSE
64			pf(1:1) = 'R'
65			ENDIF
66
67	edhill	1.13	IF ( PTRACERS_snapshot_mnc ) THEN
68	edhill	1.4	CALL MNC_CW_SET_UDIM('ptracers', -1, myThid)
69	edhill	1.12	CALL MNC_CW_RL_W_S('D','ptracers',0,0,'T',myTime,myThid)
70	edhill	1.4	CALL MNC_CW_SET_UDIM('ptracers', 0, myThid)
71	edhill	1.12	CALL MNC_CW_I_W_S('I','ptracers',0,0,'iter',myIter,myThid)
72	mlosch	1.8	DO iTracer = 1,PTRACERS_numInUse
73	edhill	1.15	CALL MNC_CW_RL_W(pf,'ptracers',0,0,PTRACERS_names(iTracer),
74	mlosch	1.8	& pTracer(1-OLx,1-OLy,1,1,1,iTracer),myThid)
75	edhill	1.4	ENDDO
76	mlosch	1.8	ENDIF
77	edhill	1.4	#endif /* ALLOW_MNC */
78
79	edhill	1.13	IF ( PTRACERS_snapshot_mdsio ) THEN
80	adcroft	1.1
81	edhill	1.4	C Loop over tracers
82			DO iTracer=1,PTRACERS_numInUse
83	adcroft	1.1
84			#ifdef MULTIPLE_RECORD_STATE_FILES
85	mlosch	1.8	C Write each snap-shot as a record in a time-history file
86			IF (PTRACERS_useRecords) THEN
87			C Write each passive tracer as a record
88			WRITE(suff,'(A)') 'PTRACERS'
89	jmc	1.16	iRec = 1 + NINT( (myTime-startTime) / PTRACERS_dumpFreq )
90	mlosch	1.8	iRec = (iRec-1)*PTRACERS_num + iTracer + 1
91			ELSE
92			C Write each passive tracer in its own file
93			WRITE(pref,'(A7,I2.2)') 'PTRACER',iTracer
94	jmc	1.16	iRec = 1 + NINT( (myTime-startTime) / PTRACERS_dumpFreq )
95	mlosch	1.8	ENDIF
96	jmc	1.16	#else
97	edhill	1.4	C Write each snap-shot as a new file with a 10-digit suffix to
98	mlosch	1.8	C indicate time-step number
99			IF (PTRACERS_useRecords) THEN
100			C Write each passive tracer as a record
101			WRITE(suff,'(A,I10.10)') 'PTRACERS',myIter
102			iRec=iTracer
103			ELSE
104			C Write each passive tracer in its own file
105	jmc	1.16	WRITE(suff,'(A7,I2.2,A1,I10.10)')
106	mlosch	1.8	& 'PTRACER',iTracer,'.',myIter
107			iRec=1
108			ENDIF
109	adcroft	1.1	#endif /* MULTIPLE_RECORD_STATE_FILES */
110	jmc	1.16
111	mlosch	1.8	CALL WRITE_REC_XYZ_RL(suff,
112			& pTracer(1-Olx,1-Oly,1,1,1,iTracer),iRec,myIter,myThid)
113	jmc	1.16
114	mlosch	1.8	C End of tracer loop
115	edhill	1.4	ENDDO
116	jmc	1.16
117	mlosch	1.8	ENDIF
118
119			_BARRIER
120	jmc	1.16	C-- Writing to files: end
121	edhill	1.4	ENDIF
122	mlosch	1.8
123	adcroft	1.1	#endif /* ALLOW_PTRACERS */
124
125			RETURN
126			END