pkg/ecco/ecco_write_pickup.F

b0b45f2373 Ou W*0001 #include "ECCO_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: ECCO_WRITE_PICKUP
                0005 C     !INTERFACE:
                0006       SUBROUTINE ECCO_WRITE_PICKUP( permPickup, suff,
                0007      I                              myTime, myIter, myThid )
                0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *================================================================*
                0011 C     | SUBROUTINE ECCO_WRITE_PICKUP
                0012 C     | o write ecco pickups
                0013 C     *================================================================*
                0014 C     \ev
                0015
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 C     === Global variables ===
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "ECCO_SIZE.h"
                0023 #include "ECCO.h"
                0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     permPickup :: write a permanent pickup
                0027 C     suff    :: suffix for pickup file (eg. ckptA or 0000000010)
                0028 C     myTime  :: Current time in simulation
                0029 C     myIter  :: Current iteration number in simulation
                0030 C     myThid  :: My Thread Id number
                0031       LOGICAL permPickup
                0032       CHARACTER*(*) suff
                0033       _RL     myTime
                0034       INTEGER myIter
                0035       INTEGER myThid
                0036
                0037 #ifdef ALLOW_PSBAR_STERIC
                0038 C     !LOCAL VARIABLES:
                0039       CHARACTER*(MAX_LEN_FNAM) fn
                0040 c     CHARACTER*(MAX_LEN_MBUF) msgBuf
                0041       INTEGER prec, ioUnit
                0042       _RL tmparr(2), dummyRS(1)
                0043 CEOP
                0044
                0045       WRITE(fn,'(A,A10)') 'pickup_ecco.',suff
                0046       IF ( fn .NE. ' ' ) THEN
                0047         ioUnit = 0
                0048         prec = precFloat64
                0049
                0050         tmparr(1) = VOLsumGlob_0
                0051         tmparr(2) = RHOsumGlob_0
                0052 #ifdef ALLOW_MDSIO
                0053         CALL MDS_WRITEVEC_LOC(
                0054      I             fn, prec, ioUnit,
                0055      I             'RL', 2, tmparr, dummyRS,
                0056      I             0, 0, 1, myIter, myThid )
                0057 #else
                0058         STOP 'ABNORMAL END: S/R ECCO_WRITE_PICKUP: Needs MDSIO pkg'
                0059 #endif
                0060       ENDIF
                0061
                0062 #endif /*  ALLOW_PSBAR_STERIC  */
                0063
                0064       RETURN
                0065       END