pkg/rw/write_fld_3d_rs.F

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