pkg/rw/read_fld_xyz_rl.F

43f4355a12 Jean*0001 #include "RW_OPTIONS.h"
090cc462c0 Alis*0002
                0003       SUBROUTINE READ_FLD_XYZ_RL( pref,suff,field,myIter,myThid)
                0004 C READ_FLD_XYZ_RL is a "front-end" interface to the low-level I/O
                0005 C routines. It assumes single record files.
                0006       IMPLICIT NONE
                0007 C Global
                0008 #include "SIZE.h"
                0009 #include "EEPARAMS.h"
                0010 #include "PARAMS.h"
                0011 C Arguments
                0012       CHARACTER*(*) pref,suff
                0013       _RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
                0014       INTEGER myIter
                0015       INTEGER myThid
                0016 C Functions
                0017       INTEGER ILNBLNK,IFNBLNK
                0018 C Local
db485ffb38 Jean*0019       LOGICAL useCurrentDir
1ab8368700 Jean*0020       _RS dummyRS(1)
090cc462c0 Alis*0021       CHARACTER*(2) fType
                0022       INTEGER nNz
db485ffb38 Jean*0023       INTEGER iRec
090cc462c0 Alis*0024       INTEGER s1Lo,s1Hi,s2Lo,s2Hi
4406cfad08 Jean*0025       CHARACTER*(MAX_LEN_FNAM) fullName
090cc462c0 Alis*0026 C
                0027 C--   Build file name
                0028 C     Name has form 'prefix.suffix'
                0029 C     e.g. U.0000000100
                0030       s1Lo = IFNBLNK(pref)
                0031       s1Hi = ILNBLNK(pref)
                0032       IF ( suff .EQ. ' ' ) THEN
                0033        WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
                0034       ELSE
                0035        s2Lo = IFNBLNK(suff)
                0036        s2Hi = ILNBLNK(suff)
                0037        WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
                0038       ENDIF
db485ffb38 Jean*0039
                0040       useCurrentDir = .FALSE.
090cc462c0 Alis*0041       fType='RL'
                0042       nNz=Nr
db485ffb38 Jean*0043       iRec=1
43f4355a12 Jean*0044 #ifdef ALLOW_MDSIO
db485ffb38 Jean*0045       CALL MDS_READ_FIELD(
                0046      I                     fullName, readBinaryPrec, useCurrentDir,
                0047      I                     fType, nNz, 1, nNz,
1ab8368700 Jean*0048      O                     field, dummyRS,
db485ffb38 Jean*0049      I                     iRec, myThid )
43f4355a12 Jean*0050 #endif
090cc462c0 Alis*0051       RETURN
                0052       END