pkg/rw/write_glvec_rs.F

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