/[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.7 - (show annotations) (download)
Tue Mar 29 02:22:42 2011 UTC (13 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint63p, checkpoint63q, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint63, checkpoint62w, checkpoint62v, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.6: +20 -7 lines
no iteration suffix if myIter < 0

1 C $Header: /u/gcmpack/MITgcm/pkg/debug/write_fullarray_rl.F,v 1.6 2010/05/25 19:07:53 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
33 C !INPUT/OUTPUT PARAMETERS:
34 C == Routine arguments ==
35 CHARACTER*(*) fnam
36 INTEGER kSize
37 INTEGER biArg, bjArg
38 INTEGER iRec
39 INTEGER myIter
40 INTEGER myThid
41 _RL fld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,kSize,nSx,nSy)
42
43 C !FUNCTIONS:
44 C == Functions ==
45 INTEGER ILNBLNK, IFNBLNK, MDS_RECLEN
46 EXTERNAL ILNBLNK, IFNBLNK, MDS_RECLEN
47
48 C !LOCAL VARIABLES:
49 C == Local variables ==
50 INTEGER i,j,k,bi,bj,iG,jG
51 INTEGER s1Lo,s1Hi, dUnit, filePrec, length_of_rec, kRec
52 CHARACTER*(MAX_LEN_FNAM) fullName
53 CEOP
54
55
56 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
57
58 C-- Only do I/O if I am the master thread
59 _BEGIN_MASTER( myThid )
60
61 C-- to Build file name
62 s1Lo = IFNBLNK(fnam)
63 s1Hi = ILNBLNK(fnam)
64 CALL MDSFINDUNIT( dUnit, myThid )
65
66 C-- file precision has to match array type (no copy to buffer)
67 #ifdef RL_IS_REAL4
68 filePrec = precFloat32
69 #else
70 filePrec = precFloat64
71 #endif
72
73 IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
74 C-- Write full global array:
75 DO bj = 1,nSy
76 DO bi = 1,nSx
77 iG=bi+(myXGlobalLo-1)/sNx
78 jG=bj+(myYGlobalLo-1)/sNy
79
80 IF ( myIter.GE.0 ) THEN
81 WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
82 & fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
83 ELSE
84 WRITE( fullName, '(A,2(A,I3.3),A)' )
85 & fnam(s1Lo:s1Hi),'.',iG,'.',jG,'.data'
86 ENDIF
87
88 c OPEN( dUnit, file=fullName, status='unknown',
89 c & form='unformatted')
90 c WRITE(dUnit) ((( fld(i,j,k,bi,bj),
91 c & i=1-Olx,sNx+Olx),
92 c & j=1-Oly,sNy+Oly),
93 c & k=1,kSize)
94 length_of_rec = MDS_RECLEN(
95 & filePrec, (sNx+2*Olx)*(sNy+2*Oly), myThid )
96 OPEN( dUnit, file=fullName, status='unknown',
97 & access='direct', recl=length_of_rec )
98 DO k = 1,kSize
99 kRec = k + (iRec-1)*kSize
100 WRITE(dUnit,rec=kRec) (( fld(i,j,k,bi,bj),
101 & i=1-Olx,sNx+Olx),
102 & j=1-Oly,sNy+Oly )
103 ENDDO
104 CLOSE(dUnit)
105
106 ENDDO
107 ENDDO
108
109 ELSE
110 C-- Write local array:
111 iG=biArg+(myXGlobalLo-1)/sNx
112 jG=bjArg+(myYGlobalLo-1)/sNy
113
114 IF ( myIter.GE.0 ) THEN
115 WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
116 & fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
117 ELSE
118 WRITE( fullName, '(A,2(A,I3.3),A)' )
119 & fnam(s1Lo:s1Hi),'.',iG,'.',jG,'.data'
120 ENDIF
121
122 c OPEN( dUnit, file=fullName, status='unknown',
123 c & form='unformatted')
124 c WRITE(dUnit) ((( fld(i,j,k,1,1),
125 c & i=1-Olx,sNx+Olx),
126 c & j=1-Oly,sNy+Oly),
127 c & k=1,kSize)
128 length_of_rec = MDS_RECLEN(
129 & filePrec, (sNx+2*Olx)*(sNy+2*Oly), myThid )
130 OPEN( dUnit, file=fullName, status='unknown',
131 & access='direct', recl=length_of_rec )
132 DO k = 1,kSize
133 kRec = k + (iRec-1)*kSize
134 WRITE(dUnit,rec=kRec) (( fld(i,j,k,1,1),
135 & i=1-Olx,sNx+Olx),
136 & j=1-Oly,sNy+Oly )
137 ENDDO
138 CLOSE(dUnit)
139
140 ENDIF
141
142 _END_MASTER( myThid )
143
144 RETURN
145 END

  ViewVC Help
Powered by ViewVC 1.1.22