File indexing completed on 2018-03-02 18:43:08 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
43b0ee4163 Jean*0001 #include "RW_OPTIONS.h"
0002
0003
0004
0005
0006 SUBROUTINE WRITE_FLD_S3D_RS(
0007 I pref, suff, Ovl, nNz, field, myIter, myThid )
0008
0009
0010
0011
0012
0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025 IMPLICIT NONE
0026
0027 #include "SIZE.h"
0028 #include "EEPARAMS.h"
0029 #include "PARAMS.h"
0030
0031
0032
0033 CHARACTER*(*) pref,suff
0034 INTEGER Ovl
0035 INTEGER nNz
0036 _RS 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
0042 INTEGER ILNBLNK, IFNBLNK
0043 EXTERNAL ILNBLNK, IFNBLNK
0044
0045
0046
0047 INTEGER kSiz
0048 PARAMETER ( kSiz = Nr )
0049 _RS 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
0058
0059 IF ( Ovl.GT.OLx .OR. Ovl.GT.OLy ) THEN
0060 WRITE(msgBuf,'(2A,2(I3,A))') 'WRITE_FLD_S3D_RS:',
0061 & ' Argument Ovl (=', Ovl, ' ) too large (>', MIN(OLx,OLy), ' )'
0062 CALL PRINT_ERROR( msgBuf, myThid )
0063 STOP 'ABNORMAL END: S/R WRITE_FLD_S3D_RS'
0064 ENDIF
0065 IF ( nNz.GT.kSiz ) THEN
0066 WRITE(msgBuf,'(2A,2(I3,A))') 'WRITE_FLD_S3D_RS:',
0067 & ' Argument nNz (=', nNz, ' ) too large (> kSiz=', kSiz, ' )'
0068 CALL PRINT_ERROR( msgBuf, myThid )
0069 STOP 'ABNORMAL END: S/R WRITE_FLD_S3D_RS'
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_RS(
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_RS empty'
0105
0106 #endif /* RW_DISABLE_SMALL_OVERLAP */
0107
0108 RETURN
0109 END