1 |
C $Header: /u/gcmpack/models/MITgcmUV/model/src/read_write_rec.F,v 1.3 2001/02/04 14:38:48 cnh Exp $ |
2 |
C $Name: $ |
3 |
#include "CPP_OPTIONS.h" |
4 |
|
5 |
C-- File read_write_rec.F: Routines to handle mid-level I/O interface. |
6 |
C-- Contents |
7 |
C-- o SET_WRITE_GLOBAL_REC |
8 |
C-- o READ_REC_XY_RS |
9 |
C-- o READ_REC_XY_RL |
10 |
C-- o READ_REC_XYZ_RS |
11 |
C-- o READ_REC_XYZ_RL |
12 |
C-- o READ_REC_XZ_RS |
13 |
C-- o READ_REC_XZ_RL |
14 |
C-- o READ_REC_YZ_RS |
15 |
C-- o READ_REC_YZ_RL |
16 |
C-- o WRITE_REC_XY_RS |
17 |
C-- o WRITE_REC_XY_RL |
18 |
C-- o WRITE_REC_XYZ_RS |
19 |
C-- o WRITE_REC_XYZ_RL |
20 |
|
21 |
SUBROUTINE SET_WRITE_GLOBAL_REC ( flag ) |
22 |
IMPLICIT NONE |
23 |
C SET_WRITE_GLOBAL_FLD( flag ) sets an internal logical state to |
24 |
C indicate whether files written by subsequent call to the |
25 |
C READ_WRITE_FLD package should create "global" or "tiled" files. |
26 |
C flag = .TRUE. indicates "global" files |
27 |
C flag = .FALSE. indicates "tiled" files |
28 |
C |
29 |
C Arguments |
30 |
LOGICAL flag |
31 |
C Common |
32 |
COMMON /RD_WR_REC/ globalFile |
33 |
LOGICAL globalFile |
34 |
C |
35 |
globalFile=flag |
36 |
C |
37 |
RETURN |
38 |
END |
39 |
|
40 |
SUBROUTINE READ_REC_XY_RS( fName,field,iRec,myIter,myThid) |
41 |
C READ_REC_XY_RS is a "front-end" interface to the low-level I/O |
42 |
C routines. It assumes single record files. |
43 |
IMPLICIT NONE |
44 |
C Global |
45 |
#include "SIZE.h" |
46 |
#include "EEPARAMS.h" |
47 |
#include "PARAMS.h" |
48 |
C Arguments |
49 |
CHARACTER*(*) fName |
50 |
_RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) |
51 |
INTEGER iRec |
52 |
INTEGER myIter |
53 |
INTEGER myThid |
54 |
C Functions |
55 |
C INTEGER ILNBLNK |
56 |
C Local |
57 |
CHARACTER*(2) fType |
58 |
INTEGER nNz |
59 |
C INTEGER IL |
60 |
CHARACTER*(80) fullName |
61 |
C |
62 |
C IF (myIter.GE.0) THEN |
63 |
C IL=ILNBLNK( fName ) |
64 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
65 |
C ELSE |
66 |
fullName=fName |
67 |
C ENDIF |
68 |
C |
69 |
fType='RS' |
70 |
nNz=1 |
71 |
CALL MDSREADFIELD( fullName, readBinaryPrec, fType, |
72 |
& nNz, field, irec, myThid ) |
73 |
C |
74 |
RETURN |
75 |
END |
76 |
|
77 |
SUBROUTINE READ_REC_XY_RL( fName,field,iRec,myIter,myThid) |
78 |
C READ_REC_XY_RL is a "front-end" interface to the low-level I/O |
79 |
C routines. It assumes single record files. |
80 |
IMPLICIT NONE |
81 |
C Global |
82 |
#include "SIZE.h" |
83 |
#include "EEPARAMS.h" |
84 |
#include "PARAMS.h" |
85 |
C Arguments |
86 |
CHARACTER*(*) fName |
87 |
_RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) |
88 |
INTEGER iRec |
89 |
INTEGER myIter |
90 |
INTEGER myThid |
91 |
C Functions |
92 |
C INTEGER ILNBLNK |
93 |
C Local |
94 |
CHARACTER*(2) fType |
95 |
INTEGER nNz |
96 |
C INTEGER IL |
97 |
CHARACTER*(80) fullName |
98 |
C |
99 |
C IF (myIter.GE.0) THEN |
100 |
C IL=ILNBLNK( fName ) |
101 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
102 |
C ELSE |
103 |
fullName=fName |
104 |
C ENDIF |
105 |
C |
106 |
fType='RL' |
107 |
nNz=1 |
108 |
CALL MDSREADFIELD( fullName, readBinaryPrec, fType, |
109 |
& nNz, field, irec, myThid ) |
110 |
C |
111 |
RETURN |
112 |
END |
113 |
|
114 |
SUBROUTINE READ_REC_XYZ_RS( fName,field,iRec,myIter,myThid) |
115 |
C READ_REC_XYZ_RS is a "front-end" interface to the low-level I/O |
116 |
C routines. It assumes single record files. |
117 |
IMPLICIT NONE |
118 |
C Global |
119 |
#include "SIZE.h" |
120 |
#include "EEPARAMS.h" |
121 |
#include "PARAMS.h" |
122 |
C Arguments |
123 |
CHARACTER*(*) fName |
124 |
_RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy) |
125 |
INTEGER iRec |
126 |
INTEGER myIter |
127 |
INTEGER myThid |
128 |
C Functions |
129 |
C INTEGER ILNBLNK |
130 |
C Local |
131 |
CHARACTER*(2) fType |
132 |
INTEGER nNz |
133 |
C INTEGER IL |
134 |
CHARACTER*(80) fullName |
135 |
C |
136 |
C IF (myIter.GE.0) THEN |
137 |
C IL=ILNBLNK( fName ) |
138 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
139 |
C ELSE |
140 |
fullName=fName |
141 |
C ENDIF |
142 |
C |
143 |
fType='RS' |
144 |
nNz=Nr |
145 |
CALL MDSREADFIELD( fullName, readBinaryPrec, fType, |
146 |
& nNz, field, irec, myThid ) |
147 |
C |
148 |
RETURN |
149 |
END |
150 |
|
151 |
SUBROUTINE READ_REC_XYZ_RL( fName,field,iRec,myIter,myThid) |
152 |
C READ_REC_XYZ_RL is a "front-end" interface to the low-level I/O |
153 |
C routines. It assumes single record files. |
154 |
IMPLICIT NONE |
155 |
C Global |
156 |
#include "SIZE.h" |
157 |
#include "EEPARAMS.h" |
158 |
#include "PARAMS.h" |
159 |
C Arguments |
160 |
CHARACTER*(*) fName |
161 |
_RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy) |
162 |
INTEGER iRec |
163 |
INTEGER myIter |
164 |
INTEGER myThid |
165 |
C Functions |
166 |
C INTEGER ILNBLNK |
167 |
C Local |
168 |
CHARACTER*(2) fType |
169 |
INTEGER nNz |
170 |
C INTEGER IL |
171 |
CHARACTER*(80) fullName |
172 |
C |
173 |
C IF (myIter.GE.0) THEN |
174 |
C IL=ILNBLNK( fName ) |
175 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
176 |
C ELSE |
177 |
fullName=fName |
178 |
C ENDIF |
179 |
C |
180 |
fType='RL' |
181 |
nNz=Nr |
182 |
CALL MDSREADFIELD( fullName, readBinaryPrec, fType, |
183 |
& nNz, field, irec, myThid ) |
184 |
C |
185 |
RETURN |
186 |
END |
187 |
|
188 |
SUBROUTINE READ_REC_XZ_RS( fName,field,iRec,myIter,myThid) |
189 |
C READ_REC_XZ_RS is a "front-end" interface to the low-level I/O |
190 |
C routines. It assumes single record files. |
191 |
IMPLICIT NONE |
192 |
C Global |
193 |
#include "SIZE.h" |
194 |
#include "EEPARAMS.h" |
195 |
#include "PARAMS.h" |
196 |
C Arguments |
197 |
CHARACTER*(*) fName |
198 |
_RS field(1-Olx:sNx+Olx,Nr,nSx,nSy) |
199 |
INTEGER iRec |
200 |
INTEGER myIter |
201 |
INTEGER myThid |
202 |
C Functions |
203 |
C INTEGER ILNBLNK |
204 |
C Local |
205 |
CHARACTER*(2) fType |
206 |
INTEGER nNz |
207 |
C INTEGER IL |
208 |
CHARACTER*(80) fullName |
209 |
C |
210 |
C IF (myIter.GE.0) THEN |
211 |
C IL=ILNBLNK( fName ) |
212 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
213 |
C ELSE |
214 |
fullName=fName |
215 |
C ENDIF |
216 |
C |
217 |
fType='RS' |
218 |
nNz=Nr |
219 |
CALL MDSREADFIELDXZ( fullName, readBinaryPrec, fType, |
220 |
& nNz, field, irec, myThid ) |
221 |
C |
222 |
RETURN |
223 |
END |
224 |
|
225 |
SUBROUTINE READ_REC_XZ_RL( fName,field,iRec,myIter,myThid) |
226 |
C READ_REC_XZ_RL is a "front-end" interface to the low-level I/O |
227 |
C routines. It assumes single record files. |
228 |
IMPLICIT NONE |
229 |
C Global |
230 |
#include "SIZE.h" |
231 |
#include "EEPARAMS.h" |
232 |
#include "PARAMS.h" |
233 |
C Arguments |
234 |
CHARACTER*(*) fName |
235 |
_RL field(1-Olx:sNx+Olx,Nr,nSx,nSy) |
236 |
INTEGER iRec |
237 |
INTEGER myIter |
238 |
INTEGER myThid |
239 |
C Functions |
240 |
C INTEGER ILNBLNK |
241 |
C Local |
242 |
CHARACTER*(2) fType |
243 |
INTEGER nNz |
244 |
C INTEGER IL |
245 |
CHARACTER*(80) fullName |
246 |
C |
247 |
C IF (myIter.GE.0) THEN |
248 |
C IL=ILNBLNK( fName ) |
249 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
250 |
C ELSE |
251 |
fullName=fName |
252 |
C ENDIF |
253 |
C |
254 |
fType='RL' |
255 |
nNz=Nr |
256 |
CALL MDSREADFIELDXZ( fullName, readBinaryPrec, fType, |
257 |
& nNz, field, irec, myThid ) |
258 |
C |
259 |
RETURN |
260 |
END |
261 |
|
262 |
SUBROUTINE READ_REC_YZ_RS( fName,field,iRec,myIter,myThid) |
263 |
C READ_REC_YZ_RS is a "front-end" interface to the low-level I/O |
264 |
C routines. It assumes single record files. |
265 |
IMPLICIT NONE |
266 |
C Global |
267 |
#include "SIZE.h" |
268 |
#include "EEPARAMS.h" |
269 |
#include "PARAMS.h" |
270 |
C Arguments |
271 |
CHARACTER*(*) fName |
272 |
_RS field(1-Oly:sNy+Oly,Nr,nSx,nSy) |
273 |
INTEGER iRec |
274 |
INTEGER myIter |
275 |
INTEGER myThid |
276 |
C Functions |
277 |
C INTEGER ILNBLNK |
278 |
C Local |
279 |
CHARACTER*(2) fType |
280 |
INTEGER nNz |
281 |
C INTEGER IL |
282 |
CHARACTER*(80) fullName |
283 |
C |
284 |
C IF (myIter.GE.0) THEN |
285 |
C IL=ILNBLNK( fName ) |
286 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
287 |
C ELSE |
288 |
fullName=fName |
289 |
C ENDIF |
290 |
C |
291 |
fType='RS' |
292 |
nNz=Nr |
293 |
CALL MDSREADFIELDYZ( fullName, readBinaryPrec, fType, |
294 |
& nNz, field, irec, myThid ) |
295 |
C |
296 |
RETURN |
297 |
END |
298 |
|
299 |
SUBROUTINE READ_REC_YZ_RL( fName,field,iRec,myIter,myThid) |
300 |
C READ_REC_YZ_RL is a "front-end" interface to the low-level I/O |
301 |
C routines. It assumes single record files. |
302 |
IMPLICIT NONE |
303 |
C Global |
304 |
#include "SIZE.h" |
305 |
#include "EEPARAMS.h" |
306 |
#include "PARAMS.h" |
307 |
C Arguments |
308 |
CHARACTER*(*) fName |
309 |
_RL field(1-Oly:sNy+Oly,Nr,nSx,nSy) |
310 |
INTEGER iRec |
311 |
INTEGER myIter |
312 |
INTEGER myThid |
313 |
C Functions |
314 |
C INTEGER ILNBLNK |
315 |
C Local |
316 |
CHARACTER*(2) fType |
317 |
INTEGER nNz |
318 |
C INTEGER IL |
319 |
CHARACTER*(80) fullName |
320 |
C |
321 |
C IF (myIter.GE.0) THEN |
322 |
C IL=ILNBLNK( fName ) |
323 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
324 |
C ELSE |
325 |
fullName=fName |
326 |
C ENDIF |
327 |
C |
328 |
fType='RL' |
329 |
nNz=Nr |
330 |
CALL MDSREADFIELDYZ( fullName, readBinaryPrec, fType, |
331 |
& nNz, field, irec, myThid ) |
332 |
C |
333 |
RETURN |
334 |
END |
335 |
|
336 |
SUBROUTINE WRITE_REC_XY_RS( fName,field,iRec,myIter,myThid) |
337 |
C WRITE_REC_XY_RS is a "front-end" interface to the low-level I/O |
338 |
C routines. It assumes single record files. |
339 |
IMPLICIT NONE |
340 |
C Global |
341 |
#include "SIZE.h" |
342 |
#include "EEPARAMS.h" |
343 |
#include "PARAMS.h" |
344 |
C Arguments |
345 |
CHARACTER*(*) fName |
346 |
_RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) |
347 |
INTEGER iRec |
348 |
INTEGER myIter |
349 |
INTEGER myThid |
350 |
C Functions |
351 |
C INTEGER ILNBLNK |
352 |
C Common |
353 |
COMMON /RD_WR_REC/ globalFile |
354 |
LOGICAL globalFile |
355 |
C Local |
356 |
CHARACTER*(2) fType |
357 |
INTEGER nNz |
358 |
C INTEGER IL |
359 |
CHARACTER*(80) fullName |
360 |
C |
361 |
C IF (myIter.GE.0) THEN |
362 |
C IL=ILNBLNK( fName ) |
363 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
364 |
C ELSE |
365 |
fullName=fName |
366 |
C ENDIF |
367 |
C |
368 |
fType='RS' |
369 |
nNz=1 |
370 |
globalFile=.FALSE. |
371 |
CALL MDSWRITEFIELD( fullName, writeBinaryPrec, globalFile, |
372 |
& fType, nNz, field, irec, myIter, myThid ) |
373 |
C |
374 |
RETURN |
375 |
END |
376 |
|
377 |
SUBROUTINE WRITE_REC_XY_RL( fName,field,iRec,myIter,myThid) |
378 |
C WRITE_REC_XY_RL is a "front-end" interface to the low-level I/O |
379 |
C routines. It assumes single record files. |
380 |
IMPLICIT NONE |
381 |
C Global |
382 |
#include "SIZE.h" |
383 |
#include "EEPARAMS.h" |
384 |
#include "PARAMS.h" |
385 |
C Arguments |
386 |
CHARACTER*(*) fName |
387 |
_RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) |
388 |
INTEGER iRec |
389 |
INTEGER myIter |
390 |
INTEGER myThid |
391 |
C Functions |
392 |
C INTEGER ILNBLNK |
393 |
C Common |
394 |
COMMON /RD_WR_REC/ globalFile |
395 |
LOGICAL globalFile |
396 |
C Local |
397 |
CHARACTER*(2) fType |
398 |
INTEGER nNz |
399 |
C INTEGER IL |
400 |
CHARACTER*(80) fullName |
401 |
C |
402 |
C IF (myIter.GE.0) THEN |
403 |
C IL=ILNBLNK( fName ) |
404 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
405 |
C ELSE |
406 |
fullName=fName |
407 |
C ENDIF |
408 |
C |
409 |
fType='RL' |
410 |
nNz=1 |
411 |
globalFile=.FALSE. |
412 |
CALL MDSWRITEFIELD( fullName, writeBinaryPrec, globalFile, |
413 |
& fType, nNz, field, irec, myIter, myThid ) |
414 |
C |
415 |
RETURN |
416 |
END |
417 |
|
418 |
SUBROUTINE WRITE_REC_XYZ_RS( fName,field,iRec,myIter,myThid) |
419 |
C WRITE_REC_XYZ_RS is a "front-end" interface to the low-level I/O |
420 |
C routines. It assumes single record files. |
421 |
IMPLICIT NONE |
422 |
C Global |
423 |
#include "SIZE.h" |
424 |
#include "EEPARAMS.h" |
425 |
#include "PARAMS.h" |
426 |
C Arguments |
427 |
CHARACTER*(*) fName |
428 |
_RS field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy) |
429 |
INTEGER iRec |
430 |
INTEGER myIter |
431 |
INTEGER myThid |
432 |
C Functions |
433 |
C INTEGER ILNBLNK |
434 |
C Common |
435 |
COMMON /RD_WR_REC/ globalFile |
436 |
LOGICAL globalFile |
437 |
C Local |
438 |
CHARACTER*(2) fType |
439 |
INTEGER nNz |
440 |
C INTEGER IL |
441 |
CHARACTER*(80) fullName |
442 |
C |
443 |
C IF (myIter.GE.0) THEN |
444 |
C IL=ILNBLNK( fName ) |
445 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
446 |
C ELSE |
447 |
fullName=fName |
448 |
C ENDIF |
449 |
C |
450 |
fType='RS' |
451 |
nNz=Nr |
452 |
globalFile=.FALSE. |
453 |
CALL MDSWRITEFIELD( fullName, writeBinaryPrec, globalFile, |
454 |
& fType, nNz, field, irec, myIter, myThid ) |
455 |
C |
456 |
RETURN |
457 |
END |
458 |
|
459 |
SUBROUTINE WRITE_REC_XYZ_RL( fName,field,iRec,myIter,myThid) |
460 |
C WRITE_REC_XYZ_RL is a "front-end" interface to the low-level I/O |
461 |
C routines. It assumes single record files. |
462 |
IMPLICIT NONE |
463 |
C Global |
464 |
#include "SIZE.h" |
465 |
#include "EEPARAMS.h" |
466 |
#include "PARAMS.h" |
467 |
C Arguments |
468 |
CHARACTER*(*) fName |
469 |
_RL field(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy) |
470 |
INTEGER iRec |
471 |
INTEGER myIter |
472 |
INTEGER myThid |
473 |
C Functions |
474 |
C INTEGER ILNBLNK |
475 |
C Common |
476 |
COMMON /RD_WR_REC/ globalFile |
477 |
LOGICAL globalFile |
478 |
C Local |
479 |
CHARACTER*(2) fType |
480 |
INTEGER nNz |
481 |
C INTEGER IL |
482 |
CHARACTER*(80) fullName |
483 |
C |
484 |
C IF (myIter.GE.0) THEN |
485 |
C IL=ILNBLNK( fName ) |
486 |
C WRITE(fullName(1:80),'(2a,i10.10)') fName(1:IL),'.',myIter |
487 |
C ELSE |
488 |
fullName=fName |
489 |
C ENDIF |
490 |
C |
491 |
fType='RL' |
492 |
nNz=Nr |
493 |
globalFile=.FALSE. |
494 |
CALL MDSWRITEFIELD( fullName, writeBinaryPrec, globalFile, |
495 |
& fType, nNz, field, irec, myIter, myThid ) |
496 |
C |
497 |
RETURN |
498 |
END |