pkg/debug/write_fullarray_rs.F

69120513c5 Jean*0001 #include "CPP_EEOPTIONS.h"
207d64de49 Jean*0002
                0003 CBOP
                0004 C     !ROUTINE: WRITE_FULLARRAY_RS
                0005 C     !INTERFACE:
                0006       SUBROUTINE WRITE_FULLARRAY_RS( fnam, fld, kSize,
                0007      I                               biArg, bjArg,
                0008      I                               iRec, myIter, myThid )
                0009
                0010 C     !DESCRIPTION: \bv
                0011 C     *==========================================================*
                0012 C     | SUBROUTINE WRITE_FULLARRAY
                0013 C     | write full array (including the overlap) to binary files
                0014 C     *==========================================================*
                0015 C     | Only used for debugging purpose.
                0016 C     |  can write local array (with no bi,bj) corresponding to
                0017 C     |      tile biArg,bjArg
                0018 C     |  or global array (with bi,bj) (called with biArg=bjArg=0)
aa6b2555c8 Jean*0019 C     | Warning:
                0020 C     |   1) does not explicitly do the byte-swapping unless
                0021 C     |      specified by compiler option.
                0022 C     |   2) ignores writeBinaryPrec and just write output with
                0023 C     |      same precision as input array (float32/float64)
207d64de49 Jean*0024 C     *==========================================================*
                0025 C     \ev
                0026 C     !USES:
                0027       IMPLICIT NONE
                0028
                0029 C     == Global variables ===
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032
                0033 C     !INPUT/OUTPUT PARAMETERS:
                0034 C     == Routine arguments ==
                0035       CHARACTER*(*) fnam
                0036       INTEGER kSize
                0037       INTEGER biArg, bjArg
                0038       INTEGER iRec
                0039       INTEGER myIter
                0040       INTEGER myThid
aa6b2555c8 Jean*0041       _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
207d64de49 Jean*0042
                0043 C     !FUNCTIONS:
                0044 C     ==  Functions ==
                0045       INTEGER  ILNBLNK, IFNBLNK, MDS_RECLEN
                0046       EXTERNAL ILNBLNK, IFNBLNK, MDS_RECLEN
                0047
                0048 C     !LOCAL VARIABLES:
                0049 C     == Local variables ==
                0050       INTEGER i,j,k,bi,bj,iG,jG
                0051       INTEGER s1Lo,s1Hi, dUnit, filePrec, length_of_rec, kRec
                0052       CHARACTER*(MAX_LEN_FNAM) fullName
                0053 CEOP
                0054
                0055 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0056
                0057 C--   Only do I/O if I am the master thread
                0058       _BEGIN_MASTER( myThid )
                0059
                0060 C--   to Build file name
                0061       s1Lo = IFNBLNK(fnam)
                0062       s1Hi = ILNBLNK(fnam)
                0063       CALL MDSFINDUNIT( dUnit, myThid )
                0064
                0065 C--   file precision has to match array type (no copy to buffer)
                0066 #ifdef RS_IS_REAL4
                0067       filePrec = precFloat32
                0068 #else
                0069       filePrec = precFloat64
                0070 #endif
                0071
                0072       IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
                0073 C--   Write full global array:
                0074        DO bj = 1,nSy
                0075         DO bi = 1,nSx
                0076          iG=bi+(myXGlobalLo-1)/sNx
                0077          jG=bj+(myYGlobalLo-1)/sNy
                0078
                0079          IF ( myIter.GE.0 ) THEN
                0080            WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
                0081      &      fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
                0082          ELSE
                0083            WRITE( fullName, '(A,2(A,I3.3),A)' )
                0084      &      fnam(s1Lo:s1Hi),'.',iG,'.',jG,'.data'
                0085          ENDIF
                0086
                0087 c        OPEN( dUnit, file=fullName, status='unknown',
                0088 c    &         form='unformatted')
                0089 c        WRITE(dUnit) ((( fld(i,j,k,bi,bj),
aa6b2555c8 Jean*0090 c    &                        i=1-OLx,sNx+OLx),
                0091 c    &                        j=1-OLy,sNy+OLy),
207d64de49 Jean*0092 c    &                        k=1,kSize)
                0093          length_of_rec = MDS_RECLEN(
aa6b2555c8 Jean*0094      &                   filePrec, (sNx+2*OLx)*(sNy+2*OLy), myThid )
207d64de49 Jean*0095          OPEN( dUnit, file=fullName, status='unknown',
                0096      &         access='direct', recl=length_of_rec )
                0097          DO k = 1,kSize
                0098            kRec = k + (iRec-1)*kSize
                0099            WRITE(dUnit,rec=kRec) (( fld(i,j,k,bi,bj),
aa6b2555c8 Jean*0100      &                                i=1-OLx,sNx+OLx),
                0101      &                                j=1-OLy,sNy+OLy )
207d64de49 Jean*0102          ENDDO
                0103          CLOSE(dUnit)
                0104
                0105         ENDDO
                0106        ENDDO
                0107
                0108       ELSE
                0109 C--   Write local array:
                0110          iG=biArg+(myXGlobalLo-1)/sNx
                0111          jG=bjArg+(myYGlobalLo-1)/sNy
                0112
                0113          IF ( myIter.GE.0 ) THEN
                0114            WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
                0115      &      fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
                0116          ELSE
                0117            WRITE( fullName, '(A,2(A,I3.3),A)' )
                0118      &      fnam(s1Lo:s1Hi),'.',iG,'.',jG,'.data'
                0119          ENDIF
                0120
                0121 c        OPEN( dUnit, file=fullName, status='unknown',
                0122 c    &         form='unformatted')
                0123 c        WRITE(dUnit) ((( fld(i,j,k,1,1),
aa6b2555c8 Jean*0124 c    &                       i=1-OLx,sNx+OLx),
                0125 c    &                       j=1-OLy,sNy+OLy),
207d64de49 Jean*0126 c    &                       k=1,kSize)
                0127          length_of_rec = MDS_RECLEN(
aa6b2555c8 Jean*0128      &                   filePrec, (sNx+2*OLx)*(sNy+2*OLy), myThid )
207d64de49 Jean*0129          OPEN( dUnit, file=fullName, status='unknown',
                0130      &         access='direct', recl=length_of_rec )
                0131          DO k = 1,kSize
                0132            kRec = k + (iRec-1)*kSize
                0133            WRITE(dUnit,rec=kRec) (( fld(i,j,k,1,1),
aa6b2555c8 Jean*0134      &                                i=1-OLx,sNx+OLx),
                0135      &                                j=1-OLy,sNy+OLy )
207d64de49 Jean*0136          ENDDO
                0137          CLOSE(dUnit)
                0138
                0139       ENDIF
                0140
                0141       _END_MASTER( myThid )
                0142
                0143       RETURN
                0144       END