pkg/rw/write_fld_s3d_rl.F

43b0ee4163 Jean*0001 #include "RW_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: WRITE_FLD_S3D_RL
                0005 C     !INTERFACE:
                0006       SUBROUTINE WRITE_FLD_S3D_RL(
                0007      I                 pref, suff, Ovl, nNz, field, myIter, myThid )
                0008
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE WRITE_FLD_S3D_RL
                0012 C     |  Front-end interface to low-level I/O subroutine (MDSIO).
                0013 C     |  Write short (smaller overlap) 3-D "RL" type field
                0014 C     |   to binary file (prefix,suffix).
                0015 C     *==========================================================*
                0016 C     | Note: Use a local copy to full overlap array
                0017 C     |  - not very efficient
                0018 C     |  - max number of level is limited (set to kSiz)
                0019 C     |  But since it is used mainly for debugging purpose,
                0020 C     |   no attempt to improve efficiency/flexibility
                0021 C     *==========================================================*
                0022 C     \ev
                0023
                0024 C     !USES:
                0025       IMPLICIT NONE
                0026 C     === Global data ===
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030
                0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     myThid    :: my Thread Id number
                0033       CHARACTER*(*) pref,suff
                0034       INTEGER Ovl
                0035       INTEGER nNz
                0036       _RL field(1-Ovl:sNx+Ovl,1-Ovl:sNy+Ovl,nNz,nSx,nSy)
                0037       INTEGER myIter
                0038       INTEGER myThid
                0039
                0040 #ifndef RW_DISABLE_SMALL_OVERLAP
                0041 C     !FUNCTIONS:
                0042       INTEGER  ILNBLNK, IFNBLNK
                0043       EXTERNAL ILNBLNK, IFNBLNK
                0044
                0045 C     !LOCAL VARIABLES:
                0046 C     msgBuf     :: Informational/error message buffer
                0047       INTEGER kSiz
                0048       PARAMETER ( kSiz = Nr )
                0049       _RL locVar(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSiz,nSx,nSy)
                0050
                0051       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0052       CHARACTER*(MAX_LEN_FNAM) fName
                0053       INTEGER fPrec, iRec
                0054       INTEGER i,j,k,bi,bj
                0055       INTEGER s1Lo,s1Hi,s2Lo,s2Hi
                0056
                0057 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0058
                0059       IF ( Ovl.GT.OLx .OR. Ovl.GT.OLy ) THEN
                0060         WRITE(msgBuf,'(2A,2(I3,A))') 'WRITE_FLD_S3D_RL:',
                0061      &  ' Argument Ovl (=', Ovl, ' ) too large (>', MIN(OLx,OLy), ' )'
                0062         CALL PRINT_ERROR( msgBuf, myThid )
                0063         STOP 'ABNORMAL END: S/R WRITE_FLD_S3D_RL'
                0064       ENDIF
                0065       IF ( nNz.GT.kSiz ) THEN
                0066         WRITE(msgBuf,'(2A,2(I3,A))') 'WRITE_FLD_S3D_RL:',
                0067      &  ' Argument nNz (=', nNz, ' ) too large (> kSiz=', kSiz, ' )'
                0068         CALL PRINT_ERROR( msgBuf, myThid )
                0069         STOP 'ABNORMAL END: S/R WRITE_FLD_S3D_RL'
                0070       ENDIF
                0071
                0072       s1Lo = IFNBLNK(pref)
                0073       s1Hi = ILNBLNK(pref)
                0074       IF ( suff .EQ. ' ' ) THEN
                0075        WRITE( fName, '(A)' ) pref(s1Lo:s1Hi)
                0076       ELSEIF ( suff .EQ. 'I10' ) THEN
                0077        WRITE( fName, '(A,A,I10.10)' ) pref(s1Lo:s1Hi),'.',myIter
                0078       ELSE
                0079        s2Lo = IFNBLNK(suff)
                0080        s2Hi = ILNBLNK(suff)
                0081        WRITE( fName, '(A,A)' ) pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
                0082       ENDIF
                0083
                0084       DO bj=myByLo(myThid),myByHi(myThid)
                0085        DO bi=myBxLo(myThid),myBxHi(myThid)
                0086          DO k=1,nNz
                0087           DO j=1,sNy
                0088            DO i=1,sNx
                0089             locVar(i,j,k,bi,bj) = field(i,j,k,bi,bj)
                0090            ENDDO
                0091           ENDDO
                0092          ENDDO
                0093        ENDDO
                0094       ENDDO
                0095
                0096       fPrec = writeBinaryPrec
                0097       iRec  = 1
                0098       CALL WRITE_REC_LEV_RL(
                0099      I                       fName, fPrec, kSiz, 1, nNz, locVar,
                0100      I                       iRec, myIter, myThid )
                0101
                0102 #else  /* RW_DISABLE_SMALL_OVERLAP */
                0103
                0104       STOP 'ABNORMAL END: S/R WRITE_FLD_S3D_RL empty'
                0105
                0106 #endif /* RW_DISABLE_SMALL_OVERLAP */
                0107
                0108       RETURN
                0109       END