/[MITgcm]/MITgcm/pkg/mdsio/mdsio_write_meta.F
ViewVC logotype

Contents of /MITgcm/pkg/mdsio/mdsio_write_meta.F

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

Revision 1.6 - (show annotations) (download)
Sun Jan 13 22:42:26 2013 UTC (11 years, 5 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, checkpoint64c, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, 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.5: +10 -4 lines 
- write missing value (corresponding to undefined array value) to meta files;
  skip this if missing value is one (UNSET_RL would be a better value for the
  case of undefined missing value but it's current the default missing-value);
1 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_meta.F,v 1.5 2010/01/07 23:41:35 jmc Exp $
2 C $Name: $
3
4 #include "MDSIO_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: MDS_WRITE_META
8 C !INTERFACE:
9 SUBROUTINE MDS_WRITE_META(
10 I mFileName,
11 I dFileName,
12 I simulName,
13 I titleLine,
14 I filePrec,
15 I nDims, dimList, map2gl,
16 I nFlds, fldList,
17 I nTimRec, timList, misVal,
18 I nrecords, myIter, myThid )
19
20 C !DESCRIPTION: \bv
21 C *==========================================================*
22 C | S/R MDS_WRITE_META
23 C | o Write 1 meta file to disk
24 C *==========================================================*
25 C \ev
26
27 C !USES:
28 IMPLICIT NONE
29
30 C == Global variables / common blocks
31 #include "SIZE.h"
32 #include "EEPARAMS.h"
33
34 C !INPUT PARAMETERS:
35 C mFileName (string ) :: complete name of meta-file
36 C dFileName (string ) :: complete name of data-file
37 C simulName (string) :: name of this simulation
38 C titleLine (string) :: title or any descriptive comments
39 C filePrec (integer) :: number of bits per word in data-file (32 or 64)
40 C nDims (integer) :: number of dimensions
41 C dimList (integer) :: array of dimensions, etc.
42 C map2gl (integer) :: used for mapping tiled file to global file
43 C nFlds (integer) :: number of fields in "fldList"
44 C fldList (string) :: array of field names to write
45 C nTimRec (integer) :: number of time-specification in "timList"
46 C timList (real) :: array of time-specifications to write
47 C misVal (real) :: missing value (ignored if = 1.)
48 C nrecords (integer) :: record number
49 C myIter (integer) :: time-step number
50 C myThid (integer) :: my Thread Id number
51 C
52 C !OUTPUT PARAMETERS:
53 C
54 CHARACTER*(*) mFileName
55 CHARACTER*(*) dFileName
56 CHARACTER*(*) simulName
57 CHARACTER*(*) titleLine
58 INTEGER filePrec
59 INTEGER nDims
60 INTEGER dimList(3,nDims)
61 INTEGER map2gl(2)
62 INTEGER nFlds
63 CHARACTER*(8) fldList(*)
64 INTEGER nTimRec
65 _RL timList(*)
66 _RL misVal
67 INTEGER nrecords
68 INTEGER myIter
69 INTEGER myThid
70 CEOP
71
72 C !FUNCTIONS
73 INTEGER ILNBLNK
74 EXTERNAL ILNBLNK
75
76 C !LOCAL VARIABLES:
77 INTEGER i,j,ii,iL
78 INTEGER mUnit
79 c LOGICAL exst
80 CHARACTER*(MAX_LEN_MBUF) msgBuf
81
82 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83
84 C We should *read* the met-file IF it exists to check
85 C that the information we are writing is consistent
86 C with the current contents
87 c INQUIRE( file=mFileName, exist=exst )
88 C However, it is bloody difficult to parse files in fortran so someone
89 C else can do this.
90 C For now, we will assume everything is ok and that the last record
91 C is written to the last consecutive record in the file.
92
93 C- Assign a free unit number as the I/O channel for this subroutine
94 CALL MDSFINDUNIT( mUnit, myThid )
95
96 C- Open meta-file
97 OPEN( mUnit, file=mFileName, status='unknown',
98 & form='formatted' )
99
100 C- Write the simulation name
101 iL = ILNBLNK(simulName)
102 IF ( iL.GT.0 ) THEN
103 WRITE(mUnit,'(3A)') " simulation = { '",simulName(1:iL),"' };"
104 ENDIF
105
106 C- Write the number of dimensions
107 WRITE(mUnit,'(1X,A,I3,A)') 'nDims = [ ',nDims,' ];'
108
109 C- For each dimension, write the following:
110 C 1 global size (ie. the size of the global dimension of all files)
111 C 2 global start (ie. the global position of the start of this file)
112 C 3 global end (ie. the global position of the end of this file)
113
114 ii = 0
115 DO j=1,nDims
116 ii = MAX(dimList(1,j),ii)
117 ENDDO
118 WRITE(mUnit,'(1X,A)') 'dimList = ['
119 IF ( ii.LT.10000 ) THEN
120 C Small-size domain:
121 DO j=1,nDims
122 IF (j.LT.nDims) THEN
123 WRITE(mUnit,'(1X,3(I5,","))') (dimList(i,j),i=1,3)
124 ELSE
125 WRITE(mUnit,'(1X,2(I5,","),I5)') (dimList(i,j),i=1,3)
126 ENDIF
127 ENDDO
128 ELSE
129 C Large-size domain:
130 DO j=1,nDims
131 IF (j.LT.nDims) THEN
132 WRITE(mUnit,'(1X,3(I10,","))') (dimList(i,j),i=1,3)
133 ELSE
134 WRITE(mUnit,'(1X,2(I10,","),I10)') (dimList(i,j),i=1,3)
135 ENDIF
136 ENDDO
137 ENDIF
138 WRITE(mUnit,'(1X,A)') '];'
139 C- only write if different from default:
140 IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
141 WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
142 & map2gl(1),',',map2gl(2),' ];'
143 ENDIF
144
145 C- Record the precision of the file
146 IF (filePrec .EQ. precFloat32) THEN
147 WRITE(mUnit,'(1X,A)') "dataprec = [ 'float32' ];"
148 ELSEIF (filePrec .EQ. precFloat64) THEN
149 WRITE(mUnit,'(1X,A)') "dataprec = [ 'float64' ];"
150 ELSE
151 WRITE(msgBuf,'(A)')
152 & ' MDSWRITEMETA: invalid filePrec'
153 CALL PRINT_ERROR( msgBuf, myThid )
154 STOP 'ABNORMAL END: S/R MDSWRITEMETA'
155 ENDIF
156
157 C- Record the current record number
158 C This is a proxy for the actual number of records in the file.
159 C If we could read the file then we could do this properly.
160 WRITE(mUnit,'(1X,A,I5,A)') 'nrecords = [ ',nrecords,' ];'
161
162 C- Record the file-name for the binary data
163 Cveto ii=ILNBLNK( dFileName )
164 Cveto WRITE(mUnit,'(1X,3A)') 'binarydatafile = [ ',dFileName(1:ii),' ];'
165
166 C- Write the integer time (integer iteration number) for later record
167 C keeping. If the timestep number is less than 0 then we assume
168 C that the information is superfluous and do not write it.
169 IF ( myIter.GE.0 )
170 & WRITE(mUnit,'(1X,A,I10,A)') 'timeStepNumber = [ ',myIter,' ];'
171
172 C- Write list of Time records
173 C note: format might change once we have a better idea of what will
174 C be the time-information to write.
175 IF ( nTimRec.GT.0 ) THEN
176 ii = MIN(nTimRec,20)
177 WRITE(msgBuf,'(1P20E20.12)') (timList(i),i=1,ii)
178 WRITE(mUnit,'(1X,3A)') 'timeInterval = [', msgBuf(1:20*ii),' ];'
179 ENDIF
180
181 C- Write missing value
182 IF ( misVal.NE.oneRL ) THEN
183 WRITE(mUnit,'(1X,A,1PE21.14,A)')
184 & 'missingValue = [ ',misVal,' ];'
185 ENDIF
186
187 C- Write list of Fields
188 IF ( nFlds.GT.0 ) THEN
189 WRITE(mUnit,'(1X,A,I4,A)') 'nFlds = [ ', nFlds, ' ];'
190 WRITE(mUnit,'(1X,A)') 'fldList = {'
191 WRITE(mUnit,'(20(A2,A8,A1))')
192 & (" '",fldList(i),"'",i=1,nFlds)
193 WRITE(mUnit,'(1X,A)') '};'
194 ENDIF
195
196 C- Write title or comments (but ignored by rdmds)
197 iL = ILNBLNK(titleLine)
198 IF ( iL.GT.0 ) THEN
199 WRITE(mUnit,'(3A)')' /* ', titleLine(1:iL), ' */'
200 ENDIF
201
202 C- Close meta-file
203 CLOSE(mUnit)
204
205 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
206
207 RETURN
208 END
  ViewVC Help
Powered by ViewVC 1.1.22