pkg/debug/write_fullarray_rl.F

C $Header: /u/gcmpack/MITgcm/pkg/debug/write_fullarray_rl.F,v 1.4 2007/11/13 01:23:08 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,
     I                               iRec, 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 (with no bi,bj) corresponding to
C     |      tile biArg,bjArg
C     |  or global array (with bi,bj) (called 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 iRec
      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, kRec
      CHARACTER*(MAX_LEN_FNAM) 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
           kRec = k + (iRec-1)*kSize
           WRITE(dUnit,rec=kRec) (( 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
           kRec = k + (iRec-1)*kSize
           WRITE(dUnit,rec=kRec) (( fld(i,j,k,1,1),
     &                                i=1-Olx,sNx+Olx),
     &                                j=1-Oly,sNy+Oly )
         ENDDO
         CLOSE(dUnit)

      ENDIF

      _END_MASTER( myThid )

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