pkg/ecco/ecco_read_pickup.F

b0b45f2373 Ou W*0001 #include "ECCO_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: ECCO_READ_PICKUP
                0005 C     !INTERFACE:
                0006       SUBROUTINE ECCO_READ_PICKUP( myIter, myThid )
                0007
                0008 C     !DESCRIPTION: \bv
                0009 C     *================================================================*
                0010 C     | SUBROUTINE ECCO_READ_PICKUP
                0011 C     | o read ecco pickups
                0012 C     *================================================================*
                0013 C     \ev
                0014
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 C     === Global variables ===
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "ECCO_SIZE.h"
                0022 #include "ECCO.h"
                0023
                0024 C     !INPUT/OUTPUT PARAMETERS:
                0025 C     myThid :: my Thread Id number
                0026       INTEGER myIter
                0027       INTEGER myThid
                0028
                0029 #ifdef ALLOW_PSBAR_STERIC
                0030 C !FUNCTIONS:
                0031       INTEGER ILNBLNK
                0032       EXTERNAL ILNBLNK
                0033
                0034 C     !LOCAL VARIABLES:
                0035       CHARACTER*(MAX_LEN_FNAM) fn, fntmp
                0036       CHARACTER*(10) suff
                0037       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0038       INTEGER prec, IL, ioUnit
                0039       LOGICAL exst
                0040       _RL tmparr(2), dummyRS(1)
                0041 CEOP
                0042
                0043 C--   Suffix for pickup files
                0044       IF (pickupSuff.EQ.' ') THEN
                0045         IF ( rwSuffixType.EQ.0 ) THEN
                0046           WRITE(suff,'(I10.10)') myIter
                0047         ELSE
                0048           CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0049         ENDIF
                0050       ELSE
                0051         WRITE(suff,'(A10)') pickupSuff
                0052       ENDIF
                0053
                0054       _BEGIN_MASTER(myThid)
                0055
                0056       WRITE(fn,'(A,A10)') 'pickup_ecco.', suff
                0057 c#ifdef ALLOW_MDSIO
                0058 c       useCurrentDir = .FALSE.
                0059 c       CALL MDS_CHECK4FILE(
                0060 c    I                       fn, '.data', 'ECCO_READ_PICKUP',
                0061 c    O                       filNam, fileExist,
                0062 c    I                       useCurrentDir, myThid )
                0063 c#endif
                0064 C-    Check first for global file with simple name (ie. fn)
                0065       INQUIRE( file=fn, exist=exst )
                0066       IF ( .NOT.exst ) THEN
                0067 C-    Check for global file with ".data" suffix
                0068         IL  = ILNBLNK( fn )
                0069         WRITE(fntmp,'(2A)') fn(1:IL),'.data'
                0070         INQUIRE( file=fntmp, exist=exst )
                0071       ENDIF
                0072
                0073       IF (exst) THEN
                0074         ioUnit = 0
                0075         prec = precFloat64
                0076 #ifdef ALLOW_MDSIO
                0077         CALL MDS_READVEC_LOC( fn, prec, ioUnit, 'RL',
                0078      &                        2, tmparr, dummyRS, 0, 0, 1, myThid )
                0079 #else
                0080         STOP 'ABNORMAL END: S/R ECCO_READ_PICKUP: Needs MDSIO pkg'
                0081 #endif
                0082         VOLsumGlob_0 = tmparr(1)
                0083         RHOsumGlob_0 = tmparr(2)
                0084       ELSE
                0085         WRITE(msgBuf,'(2A)') 'ECCO_READ_PICKUP: ',
                0086      &        fn(1:IL)//' and '//fntmp(1:iL+5)//' not provided.'
                0087         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0088      &                      SQUEEZE_RIGHT, myThid )
                0089         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0090      &                      SQUEEZE_RIGHT, myThid )
                0091         WRITE(msgBuf,'(2A,I10)') 'ECCO_READ_PICKUP: ',
                0092      &   'sterGloH is referenced to its value at time step:', nIter0
                0093         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0094      &                      SQUEEZE_RIGHT, myThid )
                0095         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0096      &                      SQUEEZE_RIGHT, myThid )
                0097       ENDIF
                0098
                0099       _END_MASTER(myThid)
                0100
                0101 #endif /*  ALLOW_PSBAR_STERIC  */
                0102
                0103       RETURN
                0104       END