pkg/rw/write_local_rs.F

43f4355a12 Jean*0001 #include "RW_OPTIONS.h"
3a279374db Alis*0002
f3f8287428 Jean*0003 CBOP
                0004 C     !ROUTINE: WRITE_LOCAL_RS
                0005 C     !INTERFACE:
3a279374db Alis*0006       SUBROUTINE WRITE_LOCAL_RS(
f3f8287428 Jean*0007      I                 pref, suff, nNr, field,
                0008      I                 bi, bj, iRec, myIter, myThArg )
                0009
                0010 C     !DESCRIPTION:
                0011 C     Write "RS" type local-tile array "field" corresponding to tile bi,bj
                0012 C     to binary file (prefix,suffix) at record position "iRec".
                0013
                0014 C     !USES:
3a279374db Alis*0015       IMPLICIT NONE
f3f8287428 Jean*0016 C     Global variables / common blocks
3a279374db Alis*0017 #include "SIZE.h"
                0018 #include "EEPARAMS.h"
                0019 #include "PARAMS.h"
f3f8287428 Jean*0020
                0021 C     !INPUT/OUTPUT PARAMETERS:
                0022 C     pref    :: file name prefix
                0023 C     suff    :: file name suffix
                0024 C     nNr     :: Number of levels to write
                0025 C     field   :: field array to write
                0026 C     bi,bj   :: tile indices
                0027 C     iRec    :: record number in output file
                0028 C     myIter  :: Iteration number
                0029 C     myThArg :: thread argument (= my Thread Id or = 0 to simply
                0030 C                     write 1 tile without thread synchronisation)
3a279374db Alis*0031       CHARACTER*(*) pref,suff
                0032       INTEGER nNr
                0033       _RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nNr)
                0034       INTEGER bi,bj
                0035       INTEGER iRec
                0036       INTEGER myIter
f3f8287428 Jean*0037       INTEGER myThArg
                0038
                0039 C     !FUNCTIONS
                0040       INTEGER  IFNBLNK, ILNBLNK
                0041       EXTERNAL IFNBLNK, ILNBLNK
                0042
                0043 C     Common block
3a279374db Alis*0044       COMMON /RD_WR_FLD/ globalFile
                0045       LOGICAL globalFile
f3f8287428 Jean*0046
                0047 C     !LOCAL VARIABLES:
                0048       LOGICAL useCurrentDir
1ab8368700 Jean*0049       _RL dummyRL(1)
3a279374db Alis*0050       CHARACTER*(2) fType
4406cfad08 Jean*0051       CHARACTER*(MAX_LEN_FNAM) fullName
f3f8287428 Jean*0052       INTEGER s1Lo,s1Hi,s2Lo,s2Hi
                0053       INTEGER myThid
3a279374db Alis*0054
                0055 C--   Build file name
                0056 C     Name has form 'prefix.suffix'
                0057 C     e.g. U.0000000100
                0058       s1Lo = IFNBLNK(pref)
                0059       s1Hi = ILNBLNK(pref)
                0060       IF ( suff .EQ. ' ' ) THEN
                0061        WRITE( fullName, '(A)' ) pref(s1Lo:s1Hi)
                0062       ELSEIF ( suff .EQ. 'I10' ) THEN
                0063        WRITE( fullName, '(A,A,I10.10)' ) pref(s1Lo:s1Hi),'.',myIter
                0064       ELSE
                0065        s2Lo = IFNBLNK(suff)
                0066        s2Hi = ILNBLNK(suff)
                0067        WRITE( fullName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
                0068       ENDIF
                0069 C
f3f8287428 Jean*0070       useCurrentDir = .TRUE.
3a279374db Alis*0071       fType='RS'
43f4355a12 Jean*0072 #ifdef ALLOW_MDSIO
f3f8287428 Jean*0073       IF (nSx.EQ.1.AND.nSy.EQ.1) THEN
                0074 C The hack below replaces MDS_WRITELOCAL with MDS_WRITE_FIELD for
                0075 C single-threaded execution because the former does not support the
                0076 C singleCpuIo option. This is a placeholder until MDS_WRITELOCAL
                0077 C functionality is superseded by pkg/diagnostics.
                0078          myThid = MAX(myThArg,1)
                0079          CALL MDS_WRITE_FIELD(
1ab8368700 Jean*0080      I                        fullName, writeBinaryPrec,
                0081      I                        globalFile, useCurrentDir,
                0082      I                        fType, nNr, 1, nNr, dummyRL, field,
                0083      I                        iRec, myIter, myThid )
f3f8287428 Jean*0084       ELSE
                0085          CALL MDS_WRITELOCAL(
1ab8368700 Jean*0086      I                        fullName, writeBinaryPrec, globalFile,
                0087      I                        fType, nNr, dummyRL, field,
                0088      I                        bi, bj, iRec, myIter, myThArg )
f3f8287428 Jean*0089       ENDIF
43f4355a12 Jean*0090 #endif
f3f8287428 Jean*0091
3a279374db Alis*0092       RETURN
                0093       END