pkg/debug/write_fullarray_rl.F

C $Header: /u/gcmpack/MITgcm/pkg/debug/write_fullarray_rl.F,v 1.2 2004/09/23 21:21:02 jmc Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CBOP
C     !ROUTINE: WRITE_FULLARRAY_RL
C     !INTERFACE:
      SUBROUTINE WRITE_FULLARRAY_RL( fnam, fld, kSize,
     I                               biArg, bjArg, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE WRITE_FULLARRAY
C     | write full array (including the overlap) to binary files
C     *==========================================================*
C     | Only used for debugging purpose.
C     |  can write local array (tile biArg,bjArg) or global
C     |  array (with biArg=bjArg=0)
C     | Warning: does not explicitly do the byte-swapping
C     |          (=> write little-endian binary file).
C     *==========================================================*
C     \ev
C     !USES:
      IMPLICIT NONE

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

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
      CHARACTER*(*) fnam
      INTEGER kSize
      INTEGER biArg, bjArg
      INTEGER myIter
      INTEGER myThid
      _RL fld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize,nSx,nSy)

C     !FUNCTIONS:
C     ==  Functions ==
      INTEGER  ILNBLNK, IFNBLNK, MDS_RECLEN
      EXTERNAL ILNBLNK, IFNBLNK, MDS_RECLEN

C     !LOCAL VARIABLES:
C     == Local variables ==
      CHARACTER*(2) fType
      INTEGER i,j,k,bi,bj,iG,jG
      INTEGER s1Lo,s1Hi, dUnit, filePrec, length_of_rec
      CHARACTER*(80) fullName
CEOP


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'
      filePrec = precFloat64

      IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
C--   Write full global array:
       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,'.data'

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

        ENDDO
       ENDDO

      ELSE
C--   Write local array:
         iG=biArg+(myXGlobalLo-1)/sNx
         jG=bjArg+(myYGlobalLo-1)/sNy

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

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

      ENDIF

      _END_MASTER( myThid )

      RETURN
      END
1	jmc	1.3	C $Header: /u/gcmpack/MITgcm/pkg/debug/write_fullarray_rl.F,v 1.2 2004/09/23 21:21:02 jmc Exp $
2	jmc	1.1	C $Name: $
3
4			#include "CPP_OPTIONS.h"
5
6	jmc	1.3	CBOP
7			C !ROUTINE: WRITE_FULLARRAY_RL
8			C !INTERFACE:
9			SUBROUTINE WRITE_FULLARRAY_RL( fnam, fld, kSize,
10			I biArg, bjArg, myIter, myThid )
11
12			C !DESCRIPTION: \bv
13	jmc	1.1	C ==========================================================
14			C \| SUBROUTINE WRITE_FULLARRAY
15			C \| write full array (including the overlap) to binary files
16			C ==========================================================
17			C \| Only used for debugging purpose.
18	jmc	1.2	C \| can write local array (tile biArg,bjArg) or global
19			C \| array (with biArg=bjArg=0)
20	jmc	1.3	C \| Warning: does not explicitly do the byte-swapping
21			C \| (=> write little-endian binary file).
22	jmc	1.1	C ==========================================================
23	jmc	1.3	C \ev
24			C !USES:
25	jmc	1.1	IMPLICIT NONE
26
27			C == Global variables ===
28			#include "SIZE.h"
29			#include "EEPARAMS.h"
30	jmc	1.3	#include "PARAMS.h"
31	jmc	1.1
32	jmc	1.3	C !INPUT/OUTPUT PARAMETERS:
33	jmc	1.1	C == Routine arguments ==
34			CHARACTER() fnam
35			INTEGER kSize
36	jmc	1.2	INTEGER biArg, bjArg
37	jmc	1.1	INTEGER myIter
38			INTEGER myThid
39			_RL fld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize,nSx,nSy)
40	jmc	1.3
41			C !FUNCTIONS:
42	jmc	1.1	C == Functions ==
43	jmc	1.3	INTEGER ILNBLNK, IFNBLNK, MDS_RECLEN
44			EXTERNAL ILNBLNK, IFNBLNK, MDS_RECLEN
45	jmc	1.1
46	jmc	1.3	C !LOCAL VARIABLES:
47	jmc	1.1	C == Local variables ==
48			CHARACTER*(2) fType
49			INTEGER i,j,k,bi,bj,iG,jG
50	jmc	1.3	INTEGER s1Lo,s1Hi, dUnit, filePrec, length_of_rec
51	jmc	1.1	CHARACTER*(80) fullName
52	jmc	1.3	CEOP
53
54	jmc	1.1
55			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
56
57			C-- Only do I/O if I am the master thread
58			_BEGIN_MASTER( myThid )
59
60			C-- to Build file name
61			s1Lo = IFNBLNK(fnam)
62			s1Hi = ILNBLNK(fnam)
63	jmc	1.3	CALL MDSFINDUNIT( dUnit, myThid )
64	jmc	1.1
65			fType='RL'
66	jmc	1.3	filePrec = precFloat64
67
68	jmc	1.2	IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
69			C-- Write full global array:
70			DO bj = 1,nSy
71			DO bi = 1,nSx
72			iG=bi+(myXGlobalLo-1)/sNx
73			jG=bj+(myYGlobalLo-1)/sNy
74	jmc	1.1
75	jmc	1.3	WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
76			& fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
77	jmc	1.1
78	jmc	1.3	c OPEN( dUnit, file=fullName, status='unknown',
79			c & form='unformatted')
80			c WRITE(dUnit) ((( fld(i,j,k,bi,bj),
81			c & i=1-Olx,sNx+Olx),
82			c & j=1-Oly,sNy+Oly),
83			c & k=1,kSize)
84			length_of_rec = MDS_RECLEN(
85			& filePrec, (sNx+2Olx)(sNy+2*Oly), myThid )
86			OPEN( dUnit, file=fullName, status='unknown',
87			& access='direct', recl=length_of_rec )
88			DO k = 1,kSize
89			WRITE(dUnit,rec=k) (( fld(i,j,k,bi,bj),
90			& i=1-Olx,sNx+Olx),
91			& j=1-Oly,sNy+Oly )
92			ENDDO
93	jmc	1.2	CLOSE(dUnit)
94	jmc	1.1
95	jmc	1.2	ENDDO
96	jmc	1.1	ENDDO
97	jmc	1.2
98			ELSE
99			C-- Write local array:
100			iG=biArg+(myXGlobalLo-1)/sNx
101			jG=bjArg+(myYGlobalLo-1)/sNy
102
103	jmc	1.3	WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
104			& fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
105	jmc	1.2
106	jmc	1.3	c OPEN( dUnit, file=fullName, status='unknown',
107			c & form='unformatted')
108			c WRITE(dUnit) ((( fld(i,j,k,1,1),
109			c & i=1-Olx,sNx+Olx),
110			c & j=1-Oly,sNy+Oly),
111			c & k=1,kSize)
112			length_of_rec = MDS_RECLEN(
113			& filePrec, (sNx+2Olx)(sNy+2*Oly), myThid )
114			OPEN( dUnit, file=fullName, status='unknown',
115			& access='direct', recl=length_of_rec )
116			DO k = 1,kSize
117			WRITE(dUnit,rec=k) (( fld(i,j,k,bi,bj),
118			& i=1-Olx,sNx+Olx),
119			& j=1-Oly,sNy+Oly )
120			ENDDO
121	jmc	1.2	CLOSE(dUnit)
122
123			ENDIF
124	jmc	1.1
125			_END_MASTER( myThid )
126
127			RETURN
128			END