| 1 | 
molod | 
1.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 |