pkg/flt/flt_write_pickup.F

5c84e93a21 Jean*0001 #include "FLT_OPTIONS.h"
                0002
                0003
                0004       SUBROUTINE FLT_WRITE_PICKUP(
                0005      I                     suff, myTime, myIter, myThid )
                0006
                0007 C     ==================================================================
                0008 C     SUBROUTINE FLT_WRITE_PICKUP
                0009 C     ==================================================================
                0010 C     o This routine writes the actual float positions to a local files
                0011 C       that can be used as restarts
                0012 C     ==================================================================
                0013
a11169c200 Jean*0014 C     !USES:
                0015       IMPLICIT NONE
5c84e93a21 Jean*0016
a11169c200 Jean*0017 C     == global variables ==
5c84e93a21 Jean*0018 #include "SIZE.h"
a11169c200 Jean*0019 #include "EEPARAMS.h"
5c84e93a21 Jean*0020 #include "PARAMS.h"
730d8469b1 Oliv*0021 #include "FLT_SIZE.h"
5c84e93a21 Jean*0022 #include "FLT.h"
                0023
                0024 C     == routine arguments ==
                0025 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0026 C     myTime  :: current time
                0027 C     myIter  :: time-step number
                0028 C     myThid  :: my Thread Id number
                0029       CHARACTER*(*) suff
                0030       _RL myTime
                0031       INTEGER myIter, myThid
                0032
                0033 C     == Functions ==
                0034       INTEGER  ILNBLNK
                0035       EXTERNAL ILNBLNK
                0036
                0037 C     == local variables ==
                0038       CHARACTER*(MAX_LEN_FNAM) fn
                0039       CHARACTER*(MAX_LEN_MBUF) msgBuf
55f764277b Jean*0040       INTEGER ioUnit, irecord
5c84e93a21 Jean*0041       INTEGER bi, bj, imax, iLen
                0042       PARAMETER(imax=9)
                0043       INTEGER ip
                0044       _RL tmp(imax)
                0045       _RL npart_dist
db913584c6 Jean*0046       _RS dummyRS(1)
5c84e93a21 Jean*0047
                0048 C     == end of interface ==
                0049
                0050       iLen = ILNBLNK(suff)
                0051       WRITE(fn,'(A,A)') 'pickup_flt.', suff(1:iLen)
                0052       npart_dist = 0.
                0053
2a37179944 Jean*0054       _BEGIN_MASTER( myThid )
                0055        DO bj=1,nSy
                0056         DO bi=1,nSx
5c84e93a21 Jean*0057
55f764277b Jean*0058 C the standard routine mds_writevec_loc can be used here
5c84e93a21 Jean*0059 C (1) write actual number floats and time into file
                0060
55f764277b Jean*0061           tmp(1) = npart_tile(bi,bj)
                0062           tmp(2) = myIter
                0063           tmp(3) = myTime
                0064           tmp(4) = 0.
                0065           tmp(5) = 0.
                0066           tmp(6) = max_npart
2a37179944 Jean*0067           tmp(7) = imax
55f764277b Jean*0068           tmp(8) = 0.
                0069           tmp(9) = 0.
                0070
                0071           ioUnit = -1
                0072           CALL MDS_WRITEVEC_LOC( fn, precFloat64, ioUnit,
db913584c6 Jean*0073      &                           'RL', imax, tmp, dummyRS,
55f764277b Jean*0074      &                           bi,bj,-1, myIter, myThid )
5c84e93a21 Jean*0075
a11169c200 Jean*0076           DO ip=1,npart_tile(bi,bj)
5c84e93a21 Jean*0077
                0078             tmp(1) =   npart(ip,bi,bj)
                0079             tmp(2) =  tstart(ip,bi,bj)
d5477ff298 Jean*0080             tmp(3) =   ipart(ip,bi,bj)
                0081             tmp(4) =   jpart(ip,bi,bj)
5c84e93a21 Jean*0082             tmp(5) =   kpart(ip,bi,bj)
                0083             tmp(6) =  kfloat(ip,bi,bj)
                0084             tmp(7) =     iup(ip,bi,bj)
                0085             tmp(8) =    itop(ip,bi,bj)
                0086             tmp(9) =    tend(ip,bi,bj)
                0087
                0088 C (2) write float positions into file
55f764277b Jean*0089             irecord = ip+1
                0090             IF ( ip.NE.npart_tile(bi,bj) ) irecord = -irecord
                0091             CALL MDS_WRITEVEC_LOC( fn, precFloat64, ioUnit,
db913584c6 Jean*0092      &                             'RL', imax, tmp, dummyRS,
55f764277b Jean*0093      &                             bi,bj,irecord, myIter, myThid )
5c84e93a21 Jean*0094
a11169c200 Jean*0095           ENDDO
55f764277b Jean*0096           CLOSE( ioUnit )
5c84e93a21 Jean*0097
a11169c200 Jean*0098           npart_dist = npart_dist + DBLE(npart_tile(bi,bj))
5c84e93a21 Jean*0099
a11169c200 Jean*0100         ENDDO
5c84e93a21 Jean*0101        ENDDO
2a37179944 Jean*0102       _END_MASTER( myThid )
5c84e93a21 Jean*0103
2a37179944 Jean*0104       _GLOBAL_SUM_RL( npart_dist, myThid )
                0105       _BEGIN_MASTER( myThid )
                0106         WRITE(msgBuf,'(A,F16.2,A)') ' FLT_WRITE_PICKUP:',
                0107      &                  npart_dist, ' floats written'
5c84e93a21 Jean*0108         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0109      &                      SQUEEZE_RIGHT, myThid )
2a37179944 Jean*0110       _END_MASTER( myThid )
5c84e93a21 Jean*0111
                0112       RETURN
                0113       END