/[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.8 - (show annotations) (download)
Sat Aug 11 18:13:23 2012 UTC (11 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63r, checkpoint63s, checkpoint64, checkpoint65, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, HEAD
Changes since 1.7: +2 -3 lines
don't need CPP_OPTIONS.h (CPP_EEOPTIONS.h is enough)

1 C $Header: /u/gcmpack/MITgcm/pkg/debug/write_fullarray_rl.F,v 1.7 2011/03/29 02:22:42 jmc Exp $
2 C $Name: $
3
4 #include "CPP_EEOPTIONS.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 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 C-- file precision has to match array type (no copy to buffer)
66 #ifdef RL_IS_REAL4
67 filePrec = precFloat32
68 #else
69 filePrec = precFloat64
70 #endif
71
72 IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
73 C-- Write full global array:
74 DO bj = 1,nSy
75 DO bi = 1,nSx
76 iG=bi+(myXGlobalLo-1)/sNx
77 jG=bj+(myYGlobalLo-1)/sNy
78
79 IF ( myIter.GE.0 ) THEN
80 WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
81 & fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
82 ELSE
83 WRITE( fullName, '(A,2(A,I3.3),A)' )
84 & fnam(s1Lo:s1Hi),'.',iG,'.',jG,'.data'
85 ENDIF
86
87 c OPEN( dUnit, file=fullName, status='unknown',
88 c & form='unformatted')
89 c WRITE(dUnit) ((( fld(i,j,k,bi,bj),
90 c & i=1-Olx,sNx+Olx),
91 c & j=1-Oly,sNy+Oly),
92 c & k=1,kSize)
93 length_of_rec = MDS_RECLEN(
94 & filePrec, (sNx+2*Olx)*(sNy+2*Oly), myThid )
95 OPEN( dUnit, file=fullName, status='unknown',
96 & access='direct', recl=length_of_rec )
97 DO k = 1,kSize
98 kRec = k + (iRec-1)*kSize
99 WRITE(dUnit,rec=kRec) (( fld(i,j,k,bi,bj),
100 & i=1-Olx,sNx+Olx),
101 & j=1-Oly,sNy+Oly )
102 ENDDO
103 CLOSE(dUnit)
104
105 ENDDO
106 ENDDO
107
108 ELSE
109 C-- Write local array:
110 iG=biArg+(myXGlobalLo-1)/sNx
111 jG=bjArg+(myYGlobalLo-1)/sNy
112
113 IF ( myIter.GE.0 ) THEN
114 WRITE( fullName, '(2A,I10.10,2(A,I3.3),A)' )
115 & fnam(s1Lo:s1Hi),'.',myIter,'.',iG,'.',jG,'.data'
116 ELSE
117 WRITE( fullName, '(A,2(A,I3.3),A)' )
118 & fnam(s1Lo:s1Hi),'.',iG,'.',jG,'.data'
119 ENDIF
120
121 c OPEN( dUnit, file=fullName, status='unknown',
122 c & form='unformatted')
123 c WRITE(dUnit) ((( fld(i,j,k,1,1),
124 c & i=1-Olx,sNx+Olx),
125 c & j=1-Oly,sNy+Oly),
126 c & k=1,kSize)
127 length_of_rec = MDS_RECLEN(
128 & filePrec, (sNx+2*Olx)*(sNy+2*Oly), myThid )
129 OPEN( dUnit, file=fullName, status='unknown',
130 & access='direct', recl=length_of_rec )
131 DO k = 1,kSize
132 kRec = k + (iRec-1)*kSize
133 WRITE(dUnit,rec=kRec) (( fld(i,j,k,1,1),
134 & i=1-Olx,sNx+Olx),
135 & j=1-Oly,sNy+Oly )
136 ENDDO
137 CLOSE(dUnit)
138
139 ENDIF
140
141 _END_MASTER( myThid )
142
143 RETURN
144 END

  ViewVC Help
Powered by ViewVC 1.1.22