pkg/debug/write_fullarray_rl.F

69120513c5 Jean*0001 #include "CPP_EEOPTIONS.h"
fde391e9ed Jean*0002
2cd979d9c0 Jean*0003 CBOP
                0004 C     !ROUTINE: WRITE_FULLARRAY_RL
                0005 C     !INTERFACE:
                0006       SUBROUTINE WRITE_FULLARRAY_RL( fnam, fld, kSize,
abe2af3b01 Jean*0007      I                               biArg, bjArg,
                0008      I                               iRec, myIter, myThid )
2cd979d9c0 Jean*0009
                0010 C     !DESCRIPTION: \bv
fde391e9ed Jean*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.
abe2af3b01 Jean*0016 C     |  can write local array (with no bi,bj) corresponding to
7e7e5c32f5 Jean*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)
fde391e9ed Jean*0024 C     *==========================================================*
2cd979d9c0 Jean*0025 C     \ev
                0026 C     !USES:
fde391e9ed Jean*0027       IMPLICIT NONE
                0028
                0029 C     == Global variables ===
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032
2cd979d9c0 Jean*0033 C     !INPUT/OUTPUT PARAMETERS:
fde391e9ed Jean*0034 C     == Routine arguments ==
                0035       CHARACTER*(*) fnam
                0036       INTEGER kSize
b3e75893f6 Jean*0037       INTEGER biArg, bjArg
abe2af3b01 Jean*0038       INTEGER iRec
fde391e9ed Jean*0039       INTEGER myIter
                0040       INTEGER myThid
aa6b2555c8 Jean*0041       _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSize,nSx,nSy)
2cd979d9c0 Jean*0042
                0043 C     !FUNCTIONS:
fde391e9ed Jean*0044 C     ==  Functions ==
2cd979d9c0 Jean*0045       INTEGER  ILNBLNK, IFNBLNK, MDS_RECLEN
                0046       EXTERNAL ILNBLNK, IFNBLNK, MDS_RECLEN
fde391e9ed Jean*0047
2cd979d9c0 Jean*0048 C     !LOCAL VARIABLES:
fde391e9ed Jean*0049 C     == Local variables ==
                0050       INTEGER i,j,k,bi,bj,iG,jG
abe2af3b01 Jean*0051       INTEGER s1Lo,s1Hi, dUnit, filePrec, length_of_rec, kRec
                0052       CHARACTER*(MAX_LEN_FNAM) fullName
2cd979d9c0 Jean*0053 CEOP
                0054
fde391e9ed Jean*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)
2cd979d9c0 Jean*0063       CALL MDSFINDUNIT( dUnit, myThid )
fde391e9ed Jean*0064
e1d2d3b88c Jean*0065 C--   file precision has to match array type (no copy to buffer)
17689e457f Jean*0066 c#ifdef RL_IS_REAL4
                0067 c     filePrec = precFloat32
                0068 c#else
2cd979d9c0 Jean*0069       filePrec = precFloat64
17689e457f Jean*0070 c#endif
2cd979d9c0 Jean*0071
b3e75893f6 Jean*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
fde391e9ed Jean*0078
e1d2d3b88c Jean*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
2cd979d9c0 Jean*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),
2cd979d9c0 Jean*0092 c    &                        k=1,kSize)
                0093          length_of_rec = MDS_RECLEN(
aa6b2555c8 Jean*0094      &                   filePrec, (sNx+2*OLx)*(sNy+2*OLy), myThid )
2cd979d9c0 Jean*0095          OPEN( dUnit, file=fullName, status='unknown',
                0096      &         access='direct', recl=length_of_rec )
                0097          DO k = 1,kSize
abe2af3b01 Jean*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 )
2cd979d9c0 Jean*0102          ENDDO
b3e75893f6 Jean*0103          CLOSE(dUnit)
fde391e9ed Jean*0104
b3e75893f6 Jean*0105         ENDDO
fde391e9ed Jean*0106        ENDDO
b3e75893f6 Jean*0107
                0108       ELSE
                0109 C--   Write local array:
                0110          iG=biArg+(myXGlobalLo-1)/sNx
                0111          jG=bjArg+(myYGlobalLo-1)/sNy
                0112
e1d2d3b88c Jean*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
2cd979d9c0 Jean*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),
2cd979d9c0 Jean*0126 c    &                       k=1,kSize)
                0127          length_of_rec = MDS_RECLEN(
aa6b2555c8 Jean*0128      &                   filePrec, (sNx+2*OLx)*(sNy+2*OLy), myThid )
2cd979d9c0 Jean*0129          OPEN( dUnit, file=fullName, status='unknown',
                0130      &         access='direct', recl=length_of_rec )
                0131          DO k = 1,kSize
abe2af3b01 Jean*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 )
2cd979d9c0 Jean*0136          ENDDO
b3e75893f6 Jean*0137          CLOSE(dUnit)
                0138
                0139       ENDIF
fde391e9ed Jean*0140
                0141       _END_MASTER( myThid )
                0142
                0143       RETURN
                0144       END