C $Header: /u/gcmpack/MITgcm/pkg/flt/flt_write_pickup.F,v 1.9 2011/08/31 21:35:35 jmc Exp $
C $Name:  $

#include "FLT_OPTIONS.h"


      SUBROUTINE FLT_WRITE_PICKUP(
     I                     suff, myTime, myIter, myThid )

C     ==================================================================
C     SUBROUTINE FLT_WRITE_PICKUP
C     ==================================================================
C     o This routine writes the actual float positions to a local files
C       that can be used as restarts
C     ==================================================================

C     !USES:
      IMPLICIT NONE

C     == global variables ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FLT_SIZE.h"
#include "FLT.h"

C     == routine arguments ==
C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
C     myTime  :: current time
C     myIter  :: time-step number
C     myThid  :: my Thread Id number
      CHARACTER*(*) suff
      _RL myTime
      INTEGER myIter, myThid

C     == Functions ==
      INTEGER  ILNBLNK
      EXTERNAL 

C     == local variables ==
      CHARACTER*(MAX_LEN_FNAM) fn
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER ioUnit, irecord
      INTEGER bi, bj, imax, iLen
      PARAMETER(imax=9)
      INTEGER ip
      _RL tmp(imax)
      _RL npart_dist
      _RS dummyRS(1)

C     == end of interface ==

      iLen = ILNBLNK(suff)
      WRITE(fn,'(A,A)') 'pickup_flt.', suff(1:iLen)
      npart_dist = 0.

      _BEGIN_MASTER( myThid )
       DO bj=1,nSy
        DO bi=1,nSx

C the standard routine mds_writevec_loc can be used here
C (1) write actual number floats and time into file

          tmp(1) = npart_tile(bi,bj)
          tmp(2) = myIter
          tmp(3) = myTime
          tmp(4) = 0.
          tmp(5) = 0.
          tmp(6) = max_npart
          tmp(7) = imax
          tmp(8) = 0.
          tmp(9) = 0.

          ioUnit = -1
          CALL MDS_WRITEVEC_LOC( fn, precFloat64, ioUnit,
     &                           'RL', imax, tmp, dummyRS,
     &                           bi,bj,-1, myIter, myThid )

          DO ip=1,npart_tile(bi,bj)

            tmp(1) =   npart(ip,bi,bj)
            tmp(2) =  tstart(ip,bi,bj)
            tmp(3) =   ipart(ip,bi,bj)
            tmp(4) =   jpart(ip,bi,bj)
            tmp(5) =   kpart(ip,bi,bj)
            tmp(6) =  kfloat(ip,bi,bj)
            tmp(7) =     iup(ip,bi,bj)
            tmp(8) =    itop(ip,bi,bj)
            tmp(9) =    tend(ip,bi,bj)

C (2) write float positions into file
            irecord = ip+1
            IF ( ip.NE.npart_tile(bi,bj) ) irecord = -irecord
            CALL MDS_WRITEVEC_LOC( fn, precFloat64, ioUnit,
     &                             'RL', imax, tmp, dummyRS,
     &                             bi,bj,irecord, myIter, myThid )

          ENDDO
          CLOSE( ioUnit )

          npart_dist = npart_dist + DBLE(npart_tile(bi,bj))

        ENDDO
       ENDDO
      _END_MASTER( myThid )

      _GLOBAL_SUM_RL( npart_dist, myThid )
      _BEGIN_MASTER( myThid )
        WRITE(msgBuf,'(A,F16.2,A)') ' FLT_WRITE_PICKUP:',
     &                  npart_dist, ' floats written'
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
      _END_MASTER( myThid )

      RETURN
      END