pkg/rw/read_glvec_rl.F

5151e843d2 Jean*0001 #include "RW_OPTIONS.h"
                0002
                0003 CBOP
                0004 C !ROUTINE: READ_GLVEC_RL
                0005 C !INTERFACE:
                0006       SUBROUTINE READ_GLVEC_RL(
                0007      I                          pref, suff,
                0008      O                          array,
                0009      I                          sizArr, iRec, myThid )
                0010
                0011 C !DESCRIPTION:
                0012 C READ_GLVEC_RL
                0013 C  is a "front-end" interface to the low-level MDS I/O routines.
                0014 C  Reads a global (=tile independent) vector.
                0015
                0016 C !USES:
                0017       IMPLICIT NONE
                0018
                0019 C == Global Variables
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023
                0024 C !INPUT PARAMETERS:
                0025       CHARACTER*(*) pref,suff
                0026       INTEGER sizArr
                0027       _RL     array(sizArr)
                0028       INTEGER iRec
                0029       INTEGER myThid
                0030
                0031 C !FUNCTIONS:
                0032       INTEGER  ILNBLNK, IFNBLNK
                0033       EXTERNAL ILNBLNK, IFNBLNK
                0034
                0035 C !LOCAL VARIABLES:
                0036       _RS     dummyRS(1)
                0037       CHARACTER*(2) fType
                0038       INTEGER ioUnit, bi, bj
                0039       INTEGER s1Lo,s1Hi,s2Lo,s2Hi
                0040       CHARACTER*(MAX_LEN_FNAM) fullName
                0041 CEOP
                0042
                0043 C--   Build file name
                0044 C     Name has form 'prefix.suffix'
                0045 C     e.g. U.0000000100
                0046       s1Lo = IFNBLNK(pref)
                0047       s1Hi = ILNBLNK(pref)
                0048       IF ( suff .EQ. ' ' ) THEN
                0049        WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
                0050       ELSE
                0051        s2Lo = IFNBLNK(suff)
                0052        s2Hi = ILNBLNK(suff)
                0053        WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
                0054       ENDIF
                0055
                0056       ioUnit = 0
                0057       fType ='RL'
                0058       bi = 0
                0059       bj = 0
                0060 #ifdef ALLOW_MDSIO
                0061       CALL MDS_READVEC_LOC(
                0062      &                       fullName, readBinaryPrec, ioUnit,
                0063      &                       fType, sizArr, array, dummyRS,
                0064      I                       bi, bj, iRec, myThid )
                0065 #else
                0066       STOP 'ABNORMAL END: S/R READ_GLVEC_RL needs MDSIO pkg'
                0067 #endif
                0068
                0069       RETURN
                0070       END