/[MITgcm]/MITgcm/pkg/debug/write_fullarray_rl.F
ViewVC logotype

Contents of /MITgcm/pkg/debug/write_fullarray_rl.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.3 - (show annotations) (download)
Tue Aug 21 15:04:15 2007 UTC (16 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59g, checkpoint59i, checkpoint59h, checkpoint59j
Changes since 1.2: +59 -29 lines
write to direct acces file (instead of sequential acces).

1 C $Header: /u/gcmpack/MITgcm/pkg/debug/write_fullarray_rl.F,v 1.2 2004/09/23 21:21:02 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, myIter, myThid )
11
12 C !DESCRIPTION: \bv
13 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 C | can write local array (tile biArg,bjArg) or global
19 C | array (with biArg=bjArg=0)
20 C | Warning: does not explicitly do the byte-swapping
21 C | (=> write little-endian binary file).
22 C *==========================================================*
23 C \ev
24 C !USES:
25 IMPLICIT NONE
26
27 C == Global variables ===
28 #include "SIZE.h"
29 #include "EEPARAMS.h"
30 #include "PARAMS.h"
31
32 C !INPUT/OUTPUT PARAMETERS:
33 C == Routine arguments ==
34 CHARACTER*(*) fnam
35 INTEGER kSize
36 INTEGER biArg, bjArg
37 INTEGER myIter
38 INTEGER myThid
39 _RL fld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize,nSx,nSy)
40
41 C !FUNCTIONS:
42 C == Functions ==
43 INTEGER ILNBLNK, IFNBLNK, MDS_RECLEN
44 EXTERNAL ILNBLNK, IFNBLNK, MDS_RECLEN
45
46 C !LOCAL VARIABLES:
47 C == Local variables ==
48 CHARACTER*(2) fType
49 INTEGER i,j,k,bi,bj,iG,jG
50 INTEGER s1Lo,s1Hi, dUnit, filePrec, length_of_rec
51 CHARACTER*(80) fullName
52 CEOP
53
54
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 CALL MDSFINDUNIT( dUnit, myThid )
64
65 fType='RL'
66 filePrec = precFloat64
67
68 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
75 WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
76 & fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
77
78 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+2*Olx)*(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 CLOSE(dUnit)
94
95 ENDDO
96 ENDDO
97
98 ELSE
99 C-- Write local array:
100 iG=biArg+(myXGlobalLo-1)/sNx
101 jG=bjArg+(myYGlobalLo-1)/sNy
102
103 WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
104 & fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
105
106 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+2*Olx)*(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 CLOSE(dUnit)
122
123 ENDIF
124
125 _END_MASTER( myThid )
126
127 RETURN
128 END

  ViewVC Help
Powered by ViewVC 1.1.22