MITgcm_contrib/plumes/plumes_write_pickup.F

C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_write_pickup.F,v 1.2 2004/05/05 00:39:21 edhill Exp $
C $Name:  $

CBOP
C     !ROUTINE: FIZHI_WRITE_PICKUP 
C     !INTERFACE:
      SUBROUTINE FIZHI_WRITE_PICKUP( suff, myTime, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R FIZHI_WRITE_PICKUP
C     | o Writes current state of fizhi package to a pickup file
C     *==========================================================*
C     \ev

C     !USES:
CEOP
      IMPLICIT NONE

C     == Global variables ===
#include "CPP_OPTIONS.h"
#include "SIZE.h"
#include "fizhi_SIZE.h"
#include "land_SIZE.h"
#include "fizhi_coms.h"
#include "land_coms.h"
#include "EEPARAMS.h"
#include "PARAMS.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
C     myTime  :: current time
C     myIter  :: time-step number
C     myThid  :: Number of this instance
      CHARACTER*(*) suff
      _RL myTime
      INTEGER myIter
      INTEGER myThid

C     !LOCAL VARIABLES:
C     fn      :: character buffer for creating filename
C     prec    :: precision of pickup files
C     lgf     :: flag to write "global" files
      INTEGER prec, iChar, lChar
      CHARACTER*(MAX_LEN_FNAM) fn
      LOGICAL lgf

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

      lChar = 0
      DO iChar = 1,len(suff)
       IF ( suff(iChar:iChar) .NE. ' ') lChar=iChar
      ENDDO
      WRITE(fn,'(A,A)') 'pickup_fizhi.',suff(1:lChar)
      prec = precFloat64
      lgf = globalFiles

C--   Write fields as consecutive records
      CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,uphy,1,myIter,myThid)
      CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,vphy,2,myIter,myThid)
      CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,thphy,3,myIter,myThid)
      CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,sphy,4,myIter,myThid)

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_write_pickup.F,v 1.2 2004/05/05 00:39:21 edhill Exp $
2	C $Name: $
3
4	CBOP
5	C !ROUTINE: FIZHI_WRITE_PICKUP
6	C !INTERFACE:
7	SUBROUTINE FIZHI_WRITE_PICKUP( suff, myTime, myIter, myThid )
8
9	C !DESCRIPTION: \bv
10	C ==========================================================
11	C \| S/R FIZHI_WRITE_PICKUP
12	C \| o Writes current state of fizhi package to a pickup file
13	C ==========================================================
14	C \ev
15
16	C !USES:
17	CEOP
18	IMPLICIT NONE
19
20	C == Global variables ===
21	#include "CPP_OPTIONS.h"
22	#include "SIZE.h"
23	#include "fizhi_SIZE.h"
24	#include "land_SIZE.h"
25	#include "fizhi_coms.h"
26	#include "land_coms.h"
27	#include "EEPARAMS.h"
28	#include "PARAMS.h"
29
30	C !INPUT/OUTPUT PARAMETERS:
31	C == Routine Arguments ==
32	C suff :: suffix for pickup file (eg. ckptA or 0000000010)
33	C myTime :: current time
34	C myIter :: time-step number
35	C myThid :: Number of this instance
36	CHARACTER() suff
37	_RL myTime
38	INTEGER myIter
39	INTEGER myThid
40
41	C !LOCAL VARIABLES:
42	C fn :: character buffer for creating filename
43	C prec :: precision of pickup files
44	C lgf :: flag to write "global" files
45	INTEGER prec, iChar, lChar
46	CHARACTER*(MAX_LEN_FNAM) fn
47	LOGICAL lgf
48
49	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
50
51	lChar = 0
52	DO iChar = 1,len(suff)
53	IF ( suff(iChar:iChar) .NE. ' ') lChar=iChar
54	ENDDO
55	WRITE(fn,'(A,A)') 'pickup_fizhi.',suff(1:lChar)
56	prec = precFloat64
57	lgf = globalFiles
58
59	C-- Write fields as consecutive records
60	CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,uphy,1,myIter,myThid)
61	CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,vphy,2,myIter,myThid)
62	CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,thphy,3,myIter,myThid)
63	CALL MDSWRITEFIELD(fn,prec,lgf,'RL',Nrphys,sphy,4,myIter,myThid)
64
65	RETURN
66	END