pkg/debug/write_fullarray_rl.F

C $Header:  $
C $Name:  $

#include "CPP_OPTIONS.h"

CStartofinterface
      SUBROUTINE WRITE_FULLARRAY_RL(fnam, fld, kSize, myIter,myThid)
C     *==========================================================*
C     | SUBROUTINE WRITE_FULLARRAY
C     | write full array (including the overlap) to binary files
C     *==========================================================*
C     | Only used for debugging purpose.
C     *==========================================================*
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"

C     == Routine arguments ==
      CHARACTER*(*) fnam
      INTEGER kSize
      INTEGER myIter
      INTEGER myThid
      _RL fld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize,nSx,nSy)
C     ==  Functions ==
      INTEGER ILNBLNK,IFNBLNK

CEndofinterface
C     == Local variables ==
      CHARACTER*(2) fType
      INTEGER i,j,k,bi,bj,iG,jG
      INTEGER s1Lo,s1Hi, dUnit
      CHARACTER*(80) fullName

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C--   Only do I/O if I am the master thread
      _BEGIN_MASTER( myThid )

C--   to Build file name
      s1Lo = IFNBLNK(fnam)
      s1Hi = ILNBLNK(fnam)
      CALL MDSFINDUNIT( dUnit, mythid )

      fType='RL'
      
      DO bj = 1,nSy
       DO bi = 1,nSx
        iG=bi+(myXGlobalLo-1)/sNx
        jG=bj+(myYGlobalLo-1)/sNy

        WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' ) 
     &    fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.bin'

c       length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
        OPEN(dUnit, file=fullName, status='unknown', 
     &        form='unformatted')
c    &        access='direct', recl=length_of_rec )
        WRITE(dUnit) ((( fld(i,j,k,bi,bj),
     &                       i=1-Olx,sNx+Olx),
     &                       j=1-Oly,sNy+Oly),
     &                       k=1,kSize)
        CLOSE(dUnit)

       ENDDO
      ENDDO

      _END_MASTER( myThid )

      RETURN
      END
1	jmc	1.1	C $Header: $
2			C $Name: $
3
4			#include "CPP_OPTIONS.h"
5
6			CStartofinterface
7			SUBROUTINE WRITE_FULLARRAY_RL(fnam, fld, kSize, myIter,myThid)
8			C ==========================================================
9			C \| SUBROUTINE WRITE_FULLARRAY
10			C \| write full array (including the overlap) to binary files
11			C ==========================================================
12			C \| Only used for debugging purpose.
13			C ==========================================================
14			IMPLICIT NONE
15
16			C == Global variables ===
17			#include "SIZE.h"
18			#include "EEPARAMS.h"
19
20			C == Routine arguments ==
21			CHARACTER() fnam
22			INTEGER kSize
23			INTEGER myIter
24			INTEGER myThid
25			_RL fld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize,nSx,nSy)
26			C == Functions ==
27			INTEGER ILNBLNK,IFNBLNK
28
29			CEndofinterface
30			C == Local variables ==
31			CHARACTER*(2) fType
32			INTEGER i,j,k,bi,bj,iG,jG
33			INTEGER s1Lo,s1Hi, dUnit
34			CHARACTER*(80) fullName
35
36			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
37
38			C-- Only do I/O if I am the master thread
39			_BEGIN_MASTER( myThid )
40
41			C-- to Build file name
42			s1Lo = IFNBLNK(fnam)
43			s1Hi = ILNBLNK(fnam)
44			CALL MDSFINDUNIT( dUnit, mythid )
45
46			fType='RL'
47
48			DO bj = 1,nSy
49			DO bi = 1,nSx
50			iG=bi+(myXGlobalLo-1)/sNx
51			jG=bj+(myYGlobalLo-1)/sNy
52
53			WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
54			& fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.bin'
55
56			c length_of_rec=MDS_RECLEN( filePrec, sNx, mythid )
57			OPEN(dUnit, file=fullName, status='unknown',
58			& form='unformatted')
59			c & access='direct', recl=length_of_rec )
60			WRITE(dUnit) ((( fld(i,j,k,bi,bj),
61			& i=1-Olx,sNx+Olx),
62			& j=1-Oly,sNy+Oly),
63			& k=1,kSize)
64			CLOSE(dUnit)
65
66			ENDDO
67			ENDDO
68
69			_END_MASTER( myThid )
70
71			RETURN
72			END