/[MITgcm]/MITgcm/model/src/read_write.F
ViewVC logotype

Annotation of /MITgcm/model/src/read_write.F

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

Revision 1.8 - (hide annotations) (download)
Mon Jun 22 16:24:51 1998 UTC (26 years ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint9
Changes since 1.7: +28 -24 lines 
o General tidy-up.
o MPI fix. Filename changes (meta/data). salbin*y stuff.
o SST.bin SSS.bin added to verification/exp2
1 adcroft 1.8 C $Header: /u/gcmpack/models/MITgcmUV/model/src/read_write.F,v 1.6.2.2 1998/06/20 21:04:59 cnh Exp $
2 cnh 1.4 #include "CPP_EEOPTIONS.h"
3 cnh 1.1
4     C-- File read_write.F: Routines to handle mid-level I/O interface.
5     C-- Contents
6     C-- o READ_FLD_XY_RL - Read two-dimensional model _RL field.
7     C-- o READ_FLD_XYZ_RL - Read three-dimensional model _RL field.
8     C-- o WRITE_1D_I - Write list of integer values
9     C-- Uses MITgcmUV environment file format.
10     C-- o WRITE_1D_L - Write list of logical values
11     C-- Uses MITgcmUV environment file format.
12     C-- o WRITE_1D_R8 - Write list of real*8 values
13     C-- Uses MITgcmUV environment file format.
14     C-- o WRITE_FLD_XY_RL - Write two-dimensional model _RL field.
15     C-- o WRITE_FLD_XYZ_RL - Write three-dimensional model _RL field.
16 adcroft 1.8 C-- o WRITE_STATE - Write out model state.
17 adcroft 1.7 C-- o WRITE_CHECKPOINT - Write out checkpoint files for restarting.
18 cnh 1.1
19     CStartofinterface
20     SUBROUTINE READ_CHECKPOINT ( myIter, myThid )
21     C /==========================================================\
22     C | SUBROUTINE READ_CHECKPOINT |
23     C | o Controlling routine for IO to write restart file. |
24     C |==========================================================|
25     C | Read model checkpoint files for use in restart. |
26     C \==========================================================/
27    
28     C == Global variables ===
29     #include "SIZE.h"
30     #include "EEPARAMS.h"
31     #include "PARAMS.h"
32     #include "DYNVARS.h"
33     #include "CG2D.h"
34    
35     INTEGER IO_ERRCOUNT
36     EXTERNAL IO_ERRCOUNT
37    
38     C == Routine arguments ==
39     C myThid - Thread number for this instance of the routine.
40     C myIter - Iteration number
41     INTEGER myThid
42     INTEGER myIter
43     CEndofinterface
44    
45     C == Local variables ==
46     C suff - Hold suffix part of a filename
47     C beginIOErrCount - Begin and end IO error counts
48     C endIOErrCount
49     C msgBuf - Error message buffer
50     CHARACTER*(MAX_LEN_FNAM) suff
51     INTEGER beginIOErrCount
52     INTEGER endIOErrCount
53     CHARACTER*(MAX_LEN_MBUF) msgBuf
54     LOGICAL permCheckPoint
55    
56     C-- Going to really do some IO. Make everyone except master thread wait.
57     _BARRIER
58     _BEGIN_MASTER( myThid )
59    
60     C-- Set suffix for this set of data files.
61     WRITE(suff,'(I10.10)') myIter
62    
63     C-- Set IO "context" for writing state
64     CALL DFILE_SET_RO
65     CALL DFILE_SET_CONT_ON_ERROR
66     C Force 64-bit IO
67     readBinaryPrec = precFloat64
68    
69    
70     C-- Read IO error counter
71     beginIOErrCount = IO_ERRCOUNT(myThid)
72    
73     C-- Write model fields
74     C Raw fields
75     CALL READ_FLD_XYZ_RL( 'uVel.',suff, uVel, myIter, myThid)
76     CALL READ_FLD_XYZ_RL( 'gU.',suff, gU, myIter, myThid)
77     CALL READ_FLD_XYZ_RL( 'gUNm1.',suff, gUNm1, myIter, myThid)
78     CALL READ_FLD_XYZ_RL( 'vVel.',suff, vVel, myIter, myThid)
79     CALL READ_FLD_XYZ_RL( 'gV.',suff, gV, myIter, myThid)
80     CALL READ_FLD_XYZ_RL( 'gVNm1.',suff, gVNm1, myIter, myThid)
81     CALL READ_FLD_XYZ_RL( 'theta.',suff, theta, myIter, myThid)
82     CALL READ_FLD_XYZ_RL( 'gT.',suff, gT, myIter, myThid)
83     CALL READ_FLD_XYZ_RL( 'gTNm1.',suff, gTNm1, myIter, myThid)
84     CALL READ_FLD_XYZ_RL( 'salt.',suff, salt, myIter, myThid)
85     CALL READ_FLD_XYZ_RL( 'gS.',suff, gS, myIter, myThid)
86     CALL READ_FLD_XYZ_RL( 'gSNm1.',suff, gSNm1, myIter, myThid)
87     CALL READ_FLD_XY_RL ( 'cg2d_x.',suff, cg2d_x, myIter, myThid)
88 cnh 1.2 #ifdef ALLOW_CD
89     CALL READ_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
90     CALL READ_FLD_XYZ_RL( 'uVelD.',suff, uVelD, myIter, myThid)
91     CALL READ_FLD_XYZ_RL( 'vVelD.',suff, vVelD, myIter, myThid)
92     CALL READ_FLD_XYZ_RL( 'uNM1.', suff, uNM1, myIter, myThid)
93     CALL READ_FLD_XYZ_RL( 'vNM1.', suff, vNM1, myIter, myThid)
94     CALL READ_FLD_XYZ_RL( 'guCD.', suff, guCD, myIter, myThid)
95     CALL READ_FLD_XYZ_RL( 'gvCD.', suff, gvCD, myIter, myThid)
96     #endif
97 cnh 1.1
98     C-- Reread IO error counter
99     endIOErrCount = IO_ERRCOUNT(myThid)
100    
101     C-- Check for IO errors
102     IF ( endIOErrCount .NE. beginIOErrCount ) THEN
103     WRITE(msgBuf,'(A)') 'S/R READ_CHECKPOINT'
104     CALL PRINT_ERROR( msgBuf, 1 )
105     WRITE(msgBuf,'(A)') 'Error reading in model checkpoint'
106     CALL PRINT_ERROR( msgBuf, 1 )
107     WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
108     CALL PRINT_ERROR( msgBuf, 1 )
109     STOP 'ABNORMAL END: S/R READ_CHECKPOINT'
110     ELSE
111     WRITE(msgBuf,'(A,I10)') '// Model checkpoint read, timestep', myIter
112     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
113     WRITE(msgBuf,'(A)') ' '
114     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
115     ENDIF
116    
117     _END_MASTER( myThid )
118     _BARRIER
119    
120     C-- Fill in edge regions
121     _EXCH_XYZ_R8(uVel , myThid )
122     _EXCH_XYZ_R8(gu , myThid )
123     _EXCH_XYZ_R8(guNM1 , myThid )
124     _EXCH_XYZ_R8(vVel , myThid )
125     _EXCH_XYZ_R8(gv , myThid )
126     _EXCH_XYZ_R8(gvNM1 , myThid )
127     _EXCH_XYZ_R8(theta , myThid )
128     _EXCH_XYZ_R8(gt , myThid )
129     _EXCH_XYZ_R8(gtNM1 , myThid )
130     _EXCH_XYZ_R8(salt , myThid )
131     _EXCH_XYZ_R8(gs , myThid )
132     _EXCH_XYZ_R8(gsNM1 , myThid )
133     _EXCH_XY_R8 (cg2d_x, myThid )
134    
135     RETURN
136     END
137    
138     CStartofinterface
139     SUBROUTINE READ_FLD_XY_RL( pref ,suff, fld, myIter, myThid)
140     C /==========================================================\
141     C | SUBROUTINE READ_FLD_XY_RL |
142     C | o Generic two-dimensional field IO routine. |
143     C |==========================================================|
144     C | Call low-level routines to read a 2d model field. |
145     C | Handles _RL type data ( generally _RL == REAL*8 ) |
146     C \==========================================================/
147    
148     C == Global variables ==
149     #include "SIZE.h"
150 cnh 1.4 #include "EEPARAMS.h"
151 cnh 1.1 #include "PARAMS.h"
152 cnh 1.4 #include "DFILE.h"
153    
154     INTEGER IFNBLNK
155     EXTERNAL IFNBLNK
156     INTEGER ILNBLNK
157     EXTERNAL ILNBLNK
158     INTEGER IO_ERRCOUNT
159     EXTERNAL IO_ERRCOUNT
160     CEndofinterface
161    
162     C == Routine arguments ==
163     C pref - File name prefix
164     C suff - File name suffix
165     C fld - Array to be filled
166     C myIter - Timestep number
167     C myThid - Thread number calling this routine
168     CHARACTER*(*) pref
169     CHARACTER*(*) suff
170     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
171     INTEGER myIter
172     INTEGER myThid
173    
174     C == Local variables ==
175     C fNamData - Filename building strings
176     C fNamMeta
177     C fileHandle - Handle used to refer to an open DFILE file.
178     C lFilled - Used to indicate the number of elements in the
179     C IO buffer that have been filled.
180     C nXP, nYp - Processes domain extents in X and Y.
181     C iP, jP, kP - Index in processes coordinates.
182     C ib - Index in IO buffer
183     C i, j, k, bi, bj - Loop counters
184     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
185     C nDims, dimList - Local and global dataset dimensions
186     CHARACTER*(MAX_LEN_FNAM) fNamData
187     CHARACTER*(MAX_LEN_FNAM) fNamMeta
188     INTEGER fileHandle
189     INTEGER lFilled
190     INTEGER nXP, nYP
191     INTEGER iP, jP, kP, ib
192 cnh 1.6 INTEGER i,j, k, bi, bj, iG, jG
193 cnh 1.4 INTEGER s1Lo, s1Hi, s2Lo, s2Hi
194     INTEGER nDims
195     PARAMETER ( nDims = 2 )
196     INTEGER dimList(nDims*3)
197     INTEGER beginIOErrCount, endIOErrCount
198     CHARACTER*(MAX_LEN_MBUF) msgBuf
199    
200     C-- Track IO errors
201     beginIOErrCount = IO_ERRCOUNT(myThid)
202    
203     C-- Build file name
204     C Name has form 'prefix.suffix'
205     C e.g. U.0000000100
206     C U.0000000100
207     s1Lo = IFNBLNK(pref)
208     s1Hi = ILNBLNK(pref)
209     s2Lo = IFNBLNK(suff)
210     s2Hi = ILNBLNK(suff)
211 cnh 1.6 IF ( suff .EQ. ' ' ) THEN
212     WRITE( fNamData, '(A)' )
213     & pref(s1Lo:s1Hi)
214     WRITE( fNamMeta, '(A)' )
215     & pref(s1Lo:s1Hi)
216 adcroft 1.8 s2Lo = 1
217     s2Hi = 1
218 cnh 1.6 ELSE
219     WRITE( fNamData, '(A,A)' )
220 cnh 1.4 & pref(s1Lo:s1Hi),
221     & suff(s2Lo:s2Hi)
222 cnh 1.6 WRITE( fNamMeta, '(A,A)' )
223 cnh 1.4 & pref(s1Lo:s1Hi),
224     & suff(s2Lo:s2Hi)
225 cnh 1.6 ENDIF
226 cnh 1.4
227     C-- Open file
228     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
229     O fileHandle )
230     IF ( fileHandle .LE. 0 ) GOTO 1000
231    
232     C-- Set local and global data extents
233     nXP=sNx*nSx
234     nYP=sNy*nSy
235 cnh 1.6 lFilled = sNx*nSx*nPx * sNy*nSy*nPy
236 cnh 1.4 dimList(1) = nXP*nPx
237     dimList(2) = myXGlobalLo
238     dimList(3) = myXGlobalLo+nXP-1
239     dimList(4) = nYP*nPy
240     dimList(5) = myYGlobalLo
241     dimList(6) = myYGlobalLo+nYP-1
242    
243     C-- Read data
244     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
245     CALL DFILE_READ_R4( lFilled,
246     I fileHandle, myThid )
247     ELSE
248     CALL DFILE_READ_R8( lFilled,
249     I fileHandle, myThid )
250     ENDIF
251    
252     C-- Copy data from IO buffer.
253     C Also regrid it to i,j,k indexing.
254     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
255     DO bj=1,nSy
256     DO bi=1,nSx
257     DO j=1,sNy
258     DO i=1,sNx
259     iP = (bi-1)*sNx+i
260     jP = (bj-1)*sNy+j
261 cnh 1.6 iG = myXGlobalLo-1+(bi-1)*sNx+I
262     jG = myYGlobalLo-1+(bj-1)*sNy+J
263     ib = (jG-1)*nXp*nPx+iG
264 cnh 1.4 fld(i,j,bi,bj) = ioBuf_R4(ib)
265     ENDDO
266     ENDDO
267     ENDDO
268     ENDDO
269     ELSE
270     DO bj=1,nSy
271     DO bi=1,nSx
272     DO j=1,sNy
273     DO i=1,sNx
274     iP = (bi-1)*sNx+i
275     jP = (bj-1)*sNy+j
276 cnh 1.6 iG = myXGlobalLo-1+(bi-1)*sNx+I
277     jG = myYGlobalLo-1+(bj-1)*sNy+J
278     ib = (jG-1)*nXp*nPx+iG
279 cnh 1.4 fld(i,j,bi,bj) = ioBuf_R8(ib)
280     ENDDO
281     ENDDO
282     ENDDO
283     ENDDO
284     ENDIF
285    
286     C-- Close file
287     CALL DFILE_CLOSE( fileHandle, myThid )
288    
289     C-- Check errors
290     endIOerrCount = IO_ERRCOUNT(myThid)
291     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
292     WRITE(msgBuf,'(A,A,A,A)') '// Read file(s) ',
293     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
294     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
295     ELSE
296     WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
297     CALL PRINT_ERROR( msgBuf, 1 )
298     ENDIF
299    
300     1000 CONTINUE
301    
302     RETURN
303     END
304    
305     CStartofinterface
306     SUBROUTINE READ_FLD_XY_RS( pref ,suff, fld, myIter, myThid)
307     C /==========================================================\
308     C | SUBROUTINE READ_FLD_XY_RS |
309     C | o Generic two-dimensional field IO routine. |
310     C |==========================================================|
311     C | Call low-level routines to read a 2d model field. |
312     C | Handles _RS type data ( generally _RS == REAL*4 ) |
313     C \==========================================================/
314    
315     C == Global variables ==
316     #include "SIZE.h"
317 cnh 1.1 #include "EEPARAMS.h"
318 cnh 1.4 #include "PARAMS.h"
319 cnh 1.1 #include "DFILE.h"
320    
321     INTEGER IFNBLNK
322     EXTERNAL IFNBLNK
323     INTEGER ILNBLNK
324     EXTERNAL ILNBLNK
325     INTEGER IO_ERRCOUNT
326     EXTERNAL IO_ERRCOUNT
327     CEndofinterface
328    
329     C == Routine arguments ==
330     C pref - File name prefix
331     C suff - File name suffix
332     C fld - Array to be filled
333     C myIter - Timestep number
334     C myThid - Thread number calling this routine
335     CHARACTER*(*) pref
336     CHARACTER*(*) suff
337 cnh 1.4 _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
338 cnh 1.1 INTEGER myIter
339     INTEGER myThid
340    
341     C == Local variables ==
342     C fNamData - Filename building strings
343     C fNamMeta
344     C fileHandle - Handle used to refer to an open DFILE file.
345     C lFilled - Used to indicate the number of elements in the
346     C IO buffer that have been filled.
347     C nXP, nYp - Processes domain extents in X and Y.
348     C iP, jP, kP - Index in processes coordinates.
349     C ib - Index in IO buffer
350     C i, j, k, bi, bj - Loop counters
351     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
352     C nDims, dimList - Local and global dataset dimensions
353     CHARACTER*(MAX_LEN_FNAM) fNamData
354     CHARACTER*(MAX_LEN_FNAM) fNamMeta
355     INTEGER fileHandle
356     INTEGER lFilled
357     INTEGER nXP, nYP
358     INTEGER iP, jP, kP, ib
359 cnh 1.6 INTEGER i,j, k, bi, bj, iG, jG
360 cnh 1.1 INTEGER s1Lo, s1Hi, s2Lo, s2Hi
361     INTEGER nDims
362     PARAMETER ( nDims = 2 )
363     INTEGER dimList(nDims*3)
364     INTEGER beginIOErrCount, endIOErrCount
365     CHARACTER*(MAX_LEN_MBUF) msgBuf
366    
367     C-- Track IO errors
368     beginIOErrCount = IO_ERRCOUNT(myThid)
369    
370     C-- Build file name
371     C Name has form 'prefix.suffix'
372     C e.g. U.0000000100
373     C U.0000000100
374     s1Lo = IFNBLNK(pref)
375     s1Hi = ILNBLNK(pref)
376     s2Lo = IFNBLNK(suff)
377     s2Hi = ILNBLNK(suff)
378 cnh 1.5 IF ( pref .EQ. ' ' ) THEN
379     WRITE( fNamData, '(A)' )
380 cnh 1.1 & suff(s2Lo:s2Hi)
381 cnh 1.6 WRITE( fNamMeta, '(A)' )
382     & suff(s2Lo:s2Hi)
383 adcroft 1.8 s1Lo = 1
384     s1Hi = 1
385 cnh 1.5 ELSEIF ( suff .EQ. ' ' ) THEN
386     WRITE( fNamData, '(A)' )
387     & pref(s1Lo:s1Hi)
388 cnh 1.6 WRITE( fNamMeta, '(A)' )
389     & pref(s1Lo:s1Hi)
390 adcroft 1.8 s2Lo = 1
391     s2Hi = 1
392 cnh 1.5 ELSE
393     WRITE( fNamData, '(A,A)' )
394 cnh 1.1 & pref(s1Lo:s1Hi),
395     & suff(s2Lo:s2Hi)
396 cnh 1.6 WRITE( fNamMeta, '(A,A)' )
397     & pref(s1Lo:s1Hi),
398     & suff(s2Lo:s2Hi)
399 cnh 1.5 ENDIF
400 cnh 1.1
401     C-- Open file
402     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
403     O fileHandle )
404     IF ( fileHandle .LE. 0 ) GOTO 1000
405    
406     C-- Set local and global data extents
407     nXP=sNx*nSx
408     nYP=sNy*nSy
409 cnh 1.6 lFilled = sNx*nSx*nPx * sNy*nSy*nPy
410 cnh 1.1 dimList(1) = nXP*nPx
411     dimList(2) = myXGlobalLo
412     dimList(3) = myXGlobalLo+nXP-1
413     dimList(4) = nYP*nPy
414     dimList(5) = myYGlobalLo
415     dimList(6) = myYGlobalLo+nYP-1
416    
417     C-- Read data
418     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
419     CALL DFILE_READ_R4( lFilled,
420     I fileHandle, myThid )
421     ELSE
422     CALL DFILE_READ_R8( lFilled,
423     I fileHandle, myThid )
424     ENDIF
425    
426     C-- Copy data from IO buffer.
427     C Also regrid it to i,j,k indexing.
428     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
429     DO bj=1,nSy
430     DO bi=1,nSx
431     DO j=1,sNy
432     DO i=1,sNx
433     iP = (bi-1)*sNx+i
434     jP = (bj-1)*sNy+j
435 cnh 1.6 iG = myXGlobalLo-1+(bi-1)*sNx+I
436     jG = myYGlobalLo-1+(bj-1)*sNy+J
437     ib = (jG-1)*nXp*nPx+iG
438 cnh 1.1 fld(i,j,bi,bj) = ioBuf_R4(ib)
439     ENDDO
440     ENDDO
441     ENDDO
442     ENDDO
443     ELSE
444     DO bj=1,nSy
445     DO bi=1,nSx
446     DO j=1,sNy
447     DO i=1,sNx
448     iP = (bi-1)*sNx+i
449     jP = (bj-1)*sNy+j
450 cnh 1.6 iG = myXGlobalLo-1+(bi-1)*sNx+I
451     jG = myYGlobalLo-1+(bj-1)*sNy+J
452     ib = (jG-1)*nXp*nPx+iG
453 cnh 1.1 fld(i,j,bi,bj) = ioBuf_R8(ib)
454     ENDDO
455     ENDDO
456     ENDDO
457     ENDDO
458     ENDIF
459    
460     C-- Close file
461     CALL DFILE_CLOSE( fileHandle, myThid )
462    
463     C-- Check errors
464     endIOerrCount = IO_ERRCOUNT(myThid)
465     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
466     WRITE(msgBuf,'(A,A,A,A)') '// Read file(s) ',
467     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
468     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
469     ELSE
470     WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
471     CALL PRINT_ERROR( msgBuf, 1 )
472     ENDIF
473    
474     1000 CONTINUE
475    
476     RETURN
477     END
478    
479     CStartofinterface
480     SUBROUTINE READ_FLD_XYZ_RL( pref ,suff, fld, myIter, myThid)
481     C /==========================================================\
482     C | SUBROUTINE READ_FLD_XYZ_RL |
483     C | o Generic three-dimensional field IO routine. |
484     C |==========================================================|
485     C | Call low-level routines to read a 3d model field. |
486     C | Handles _RL type data ( generally _RL == REAL*8 ) |
487     C \==========================================================/
488    
489     C == Global variables ==
490     #include "SIZE.h"
491 cnh 1.4 #include "EEPARAMS.h"
492 cnh 1.1 #include "PARAMS.h"
493 cnh 1.4 #include "DFILE.h"
494    
495     INTEGER IFNBLNK
496     EXTERNAL IFNBLNK
497     INTEGER ILNBLNK
498     EXTERNAL ILNBLNK
499     INTEGER IO_ERRCOUNT
500     EXTERNAL IO_ERRCOUNT
501     CEndofinterface
502    
503     C == Routine arguments ==
504     C pref - File name prefix
505     C suff - File name suffix
506     C fld - Array to be filled
507     C myIter - Timestep number
508     C myThid - Thread number calling this routine
509     CHARACTER*(*) pref
510     CHARACTER*(*) suff
511     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nZ,nSx,nSy)
512     INTEGER myIter
513     INTEGER myThid
514    
515     C == Local variables ==
516     C fNamData - Filename building strings
517     C fNamMeta
518     C fileHandle - Handle used to refer to an open DFILE file.
519     C lFilled - Used to indicate the number of elements in the
520     C IO buffer that have been filled.
521     C nXP, nYp - Processes domain extents in X and Y.
522     C iP, jP, kP - Index in processes coordinates.
523     C ib - Index in IO buffer
524     C i, j, k, bi, bj - Loop counters
525     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
526     C nDims, dimList - Local and global dataset dimensions
527     CHARACTER*(MAX_LEN_FNAM) fNamData
528     CHARACTER*(MAX_LEN_FNAM) fNamMeta
529     INTEGER fileHandle
530     INTEGER lFilled
531     INTEGER nXP, nYP
532     INTEGER iP, jP, kP, ib
533 cnh 1.6 INTEGER i,j, k, bi, bj, iG, jG
534 cnh 1.4 INTEGER s1Lo, s1Hi, s2Lo, s2Hi
535     INTEGER nDims
536     PARAMETER ( nDims = 3 )
537     INTEGER dimList(nDims*3)
538     INTEGER beginIOErrCount, endIOErrCount
539     CHARACTER*(MAX_LEN_MBUF) msgBuf
540    
541     C-- Track IO errors
542     beginIOErrCount = IO_ERRCOUNT(myThid)
543    
544     C-- Build file name
545     C Name has form 'prefix.suffix'
546     C e.g. U.0000000100
547     C U.0000000100
548     s1Lo = IFNBLNK(pref)
549     s1Hi = ILNBLNK(pref)
550     s2Lo = IFNBLNK(suff)
551     s2Hi = ILNBLNK(suff)
552 cnh 1.6 IF ( suff .EQ. ' ' ) THEN
553     WRITE( fNamData, '(A)' )
554     & pref(s1Lo:s1Hi)
555     WRITE( fNamMeta, '(A)' )
556     & pref(s1Lo:s1Hi)
557 adcroft 1.8 s2Lo = 1
558     s2Hi = 1
559 cnh 1.6 ELSE
560     WRITE( fNamData, '(A,A)' )
561 cnh 1.4 & pref(s1Lo:s1Hi),
562     & suff(s2Lo:s2Hi)
563 cnh 1.6 WRITE( fNamMeta, '(A,A)' )
564 cnh 1.4 & pref(s1Lo:s1Hi),
565     & suff(s2Lo:s2Hi)
566 cnh 1.6 ENDIF
567 cnh 1.4
568     C-- Open file
569     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
570     O fileHandle )
571     IF ( fileHandle .LE. 0 ) GOTO 1000
572    
573     C-- Set local and global data extents
574     nXP=sNx*nSx
575     nYP=sNy*nSy
576 cnh 1.6 lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ
577 cnh 1.4 dimList(1) = nXP*nPx
578     dimList(2) = myXGlobalLo
579     dimList(3) = myXGlobalLo+nXP-1
580     dimList(4) = nYP*nPy
581     dimList(5) = myYGlobalLo
582     dimList(6) = myYGlobalLo+nYP-1
583     dimList(7) = nZ
584     dimList(8) = 1
585     dimList(9) = nZ
586    
587     C-- Read data
588     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
589     CALL DFILE_READ_R4( lFilled,
590     I fileHandle, myThid )
591     ELSE
592     CALL DFILE_READ_R8( lFilled,
593     I fileHandle, myThid )
594     ENDIF
595    
596     C-- Copy data from IO buffer.
597     C Also regrid it to i,j,k indexing.
598     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
599     DO bj=1,nSy
600     DO bi=1,nSx
601     DO K=1,nZ
602     DO j=1,sNy
603     DO i=1,sNx
604     iP = (bi-1)*sNx+i
605     jP = (bj-1)*sNy+j
606     kP = K
607 cnh 1.6 iG = myXGlobalLo-1+(bi-1)*sNx+I
608     jG = myYGlobalLo-1+(bj-1)*sNy+J
609     ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
610 cnh 1.4 fld(i,j,k,bi,bj) = ioBuf_R4(ib)
611     ENDDO
612     ENDDO
613     ENDDO
614     ENDDO
615     ENDDO
616     ELSE
617     DO bj=1,nSy
618     DO bi=1,nSx
619     DO K=1,nZ
620     DO j=1,sNy
621     DO i=1,sNx
622     iP = (bi-1)*sNx+i
623     jP = (bj-1)*sNy+j
624 cnh 1.6 kP = K
625     iG = myXGlobalLo-1+(bi-1)*sNx+I
626     jG = myYGlobalLo-1+(bj-1)*sNy+J
627     ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
628 cnh 1.4 fld(i,j,k,bi,bj) = ioBuf_R8(ib)
629     ENDDO
630     ENDDO
631     ENDDO
632     ENDDO
633     ENDDO
634     ENDIF
635    
636     C-- Close file
637     CALL DFILE_CLOSE( fileHandle, myThid )
638    
639     C-- Check errors
640     endIOerrCount = IO_ERRCOUNT(myThid)
641     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
642     WRITE(msgBuf,'(A,A,A,A)') '// Read file(s) ',
643     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
644     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
645     ELSE
646     WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
647     CALL PRINT_ERROR( msgBuf, 1 )
648     ENDIF
649    
650     1000 CONTINUE
651    
652     RETURN
653     END
654    
655     CStartofinterface
656     SUBROUTINE READ_FLD_XYZ_RS( pref ,suff, fld, myIter, myThid)
657     C /==========================================================\
658     C | SUBROUTINE READ_FLD_XYZ_RS |
659     C | o Generic three-dimensional field IO routine. |
660     C |==========================================================|
661     C | Call low-level routines to read a 3d model field. |
662     C | Handles _RS type data ( generally _RS == REAL*4 ) |
663     C \==========================================================/
664    
665     C == Global variables ==
666     #include "SIZE.h"
667 cnh 1.1 #include "EEPARAMS.h"
668 cnh 1.4 #include "PARAMS.h"
669 cnh 1.1 #include "DFILE.h"
670    
671     INTEGER IFNBLNK
672     EXTERNAL IFNBLNK
673     INTEGER ILNBLNK
674     EXTERNAL ILNBLNK
675     INTEGER IO_ERRCOUNT
676     EXTERNAL IO_ERRCOUNT
677     CEndofinterface
678    
679     C == Routine arguments ==
680     C pref - File name prefix
681     C suff - File name suffix
682     C fld - Array to be filled
683     C myIter - Timestep number
684     C myThid - Thread number calling this routine
685     CHARACTER*(*) pref
686     CHARACTER*(*) suff
687 cnh 1.4 _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nZ,nSx,nSy)
688 cnh 1.1 INTEGER myIter
689     INTEGER myThid
690    
691     C == Local variables ==
692     C fNamData - Filename building strings
693     C fNamMeta
694     C fileHandle - Handle used to refer to an open DFILE file.
695     C lFilled - Used to indicate the number of elements in the
696     C IO buffer that have been filled.
697     C nXP, nYp - Processes domain extents in X and Y.
698     C iP, jP, kP - Index in processes coordinates.
699     C ib - Index in IO buffer
700     C i, j, k, bi, bj - Loop counters
701     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
702     C nDims, dimList - Local and global dataset dimensions
703     CHARACTER*(MAX_LEN_FNAM) fNamData
704     CHARACTER*(MAX_LEN_FNAM) fNamMeta
705     INTEGER fileHandle
706     INTEGER lFilled
707     INTEGER nXP, nYP
708     INTEGER iP, jP, kP, ib
709 cnh 1.6 INTEGER i,j, k, bi, bj, iG , jG
710 cnh 1.1 INTEGER s1Lo, s1Hi, s2Lo, s2Hi
711     INTEGER nDims
712     PARAMETER ( nDims = 3 )
713     INTEGER dimList(nDims*3)
714     INTEGER beginIOErrCount, endIOErrCount
715     CHARACTER*(MAX_LEN_MBUF) msgBuf
716    
717     C-- Track IO errors
718     beginIOErrCount = IO_ERRCOUNT(myThid)
719    
720     C-- Build file name
721     C Name has form 'prefix.suffix'
722     C e.g. U.0000000100
723     C U.0000000100
724     s1Lo = IFNBLNK(pref)
725     s1Hi = ILNBLNK(pref)
726     s2Lo = IFNBLNK(suff)
727     s2Hi = ILNBLNK(suff)
728 cnh 1.6 IF ( suff .EQ. ' ' ) THEN
729     WRITE( fNamData, '(A)' )
730     & pref(s1Lo:s1Hi)
731     WRITE( fNamMeta, '(A)' )
732     & pref(s1Lo:s1Hi)
733 adcroft 1.8 s2Lo = 1
734     s2Hi = 1
735 cnh 1.6 ELSE
736     WRITE( fNamData, '(A,A)' )
737 cnh 1.1 & pref(s1Lo:s1Hi),
738     & suff(s2Lo:s2Hi)
739 cnh 1.6 WRITE( fNamMeta, '(A,A)' )
740 cnh 1.1 & pref(s1Lo:s1Hi),
741     & suff(s2Lo:s2Hi)
742 cnh 1.6 ENDIF
743    
744 cnh 1.1 C-- Open file
745     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
746     O fileHandle )
747     IF ( fileHandle .LE. 0 ) GOTO 1000
748    
749     C-- Set local and global data extents
750     nXP=sNx*nSx
751     nYP=sNy*nSy
752 cnh 1.6 lFilled = sNx*nSx*nPx * sNy*nSy*nPy * nZ
753 cnh 1.1 dimList(1) = nXP*nPx
754     dimList(2) = myXGlobalLo
755     dimList(3) = myXGlobalLo+nXP-1
756     dimList(4) = nYP*nPy
757     dimList(5) = myYGlobalLo
758     dimList(6) = myYGlobalLo+nYP-1
759     dimList(7) = nZ
760     dimList(8) = 1
761     dimList(9) = nZ
762    
763     C-- Read data
764     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
765     CALL DFILE_READ_R4( lFilled,
766     I fileHandle, myThid )
767     ELSE
768     CALL DFILE_READ_R8( lFilled,
769     I fileHandle, myThid )
770     ENDIF
771    
772     C-- Copy data from IO buffer.
773     C Also regrid it to i,j,k indexing.
774     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
775     DO bj=1,nSy
776     DO bi=1,nSx
777     DO K=1,nZ
778     DO j=1,sNy
779     DO i=1,sNx
780     iP = (bi-1)*sNx+i
781     jP = (bj-1)*sNy+j
782     kP = K
783 cnh 1.6 iG = myXGlobalLo-1+(bi-1)*sNx+I
784     jG = myYGlobalLo-1+(bj-1)*sNy+J
785     ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
786 cnh 1.1 fld(i,j,k,bi,bj) = ioBuf_R4(ib)
787     ENDDO
788     ENDDO
789     ENDDO
790     ENDDO
791     ENDDO
792     ELSE
793     DO bj=1,nSy
794     DO bi=1,nSx
795     DO K=1,nZ
796     DO j=1,sNy
797     DO i=1,sNx
798     iP = (bi-1)*sNx+i
799     jP = (bj-1)*sNy+j
800 cnh 1.6 kP = K
801     iG = myXGlobalLo-1+(bi-1)*sNx+I
802     jG = myYGlobalLo-1+(bj-1)*sNy+J
803     ib = (kP-1)*nXp*nPx*nYp*nPy+(jG-1)*nXp*nPx+iG
804 cnh 1.1 fld(i,j,k,bi,bj) = ioBuf_R8(ib)
805     ENDDO
806     ENDDO
807     ENDDO
808     ENDDO
809     ENDDO
810     ENDIF
811    
812     C-- Close file
813     CALL DFILE_CLOSE( fileHandle, myThid )
814    
815     C-- Check errors
816     endIOerrCount = IO_ERRCOUNT(myThid)
817     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
818     WRITE(msgBuf,'(A,A,A,A)') '// Read file(s) ',
819     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
820     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
821     ELSE
822     WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
823     CALL PRINT_ERROR( msgBuf, 1 )
824     ENDIF
825    
826     1000 CONTINUE
827    
828     RETURN
829     END
830    
831     CStartofinterface
832     SUBROUTINE WRITE_1D_I( fld, lFld, index_type, head, comment )
833     C /==========================================================\
834     C | o SUBROUTINE WRITE_1D_I |
835     C | Controls formatted, tabular I/O for a one-dimensional |
836     C | INTEGER field. |
837     C |==========================================================|
838     C | This routine produces a standard format for list |
839     C | one-dimensional INTEGER data in textual form. The format |
840     C | is designed to be readily parsed by a post-processing |
841     C | utility. |
842     C \==========================================================/
843    
844     C == Global data ==
845     #include "SIZE.h"
846     #include "EEPARAMS.h"
847    
848     C == Routine arguments ==
849     C fld - Field to be printed
850     C lFld - Number of elements in field fld.
851     C index_type - Type of index labelling (I=,J=,...) to use
852     C head - Statement start e.g. phi =
853     C comment - Descriptive comment for field
854     INTEGER lFld
855     INTEGER fld(lFld)
856     INTEGER index_type
857     CHARACTER*(*) head
858     CHARACTER*(*) comment
859     CEndofinterface
860    
861     C == Local variables ==
862     CHARACTER*(MAX_LEN_MBUF) msgBuf
863    
864     WRITE(msgBuf,'(A,A)') head, comment
865     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
866 adcroft 1.8 CALL PRINT_LIST_I( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )
867 cnh 1.1 WRITE(msgBuf,'(A)') ' ; '
868     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
869     C
870     RETURN
871     END
872    
873     CStartofinterface
874     SUBROUTINE WRITE_1D_L( fld, lFld, index_type, head, comment )
875     C /==========================================================\
876     C | o SUBROUTINE WRITE_1D_L |
877     C | Controls formatted, tabular I/O for a one-dimensional |
878     C | LOGICAL field. |
879     C |==========================================================|
880     C | This routine produces a standard format for list |
881     C | one-dimensional LOGICAL data in textual form. The format |
882     C | is designed to be readily parsed by a post-processing |
883     C | utility. |
884     C \==========================================================/
885    
886     C == Global data ==
887     #include "SIZE.h"
888     #include "EEPARAMS.h"
889    
890     C == Routine arguments ==
891     C fld - Field to be printed
892     C lFld - Number of elements in field fld.
893     C index_type - Type of index labelling (I=,J=,...) to use
894     C head - Statement start e.g. phi =
895     C comment - Descriptive comment for field
896     INTEGER lFld
897     LOGICAL fld(lFld)
898     INTEGER index_type
899     CHARACTER*(*) head
900     CHARACTER*(*) comment
901     CEndofinterface
902    
903     C == Local variables ==
904     CHARACTER*(MAX_LEN_MBUF) msgBuf
905    
906     WRITE(msgBuf,'(A,A)') head, comment
907     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
908 adcroft 1.8 CALL PRINT_LIST_L( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )
909 cnh 1.1 WRITE(msgBuf,'(A)') ' ; '
910     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
911     C
912     RETURN
913     END
914    
915     CStartofinterface
916     SUBROUTINE WRITE_1D_R8( fld, lFld, index_type, head, comment )
917     C /==========================================================\
918     C | o SUBROUTINE WRITE_1D_R8 |
919     C | Controls formatted, tabular I/O for a one-dimensional |
920     C | real*8 field. |
921     C |==========================================================|
922     C | This routine produces a standard format for list |
923     C | one-dimensional real*8 data in textual form. The format |
924     C | is designed to be readilya parsed by a post-processing |
925     C | utility. |
926     C \==========================================================/
927    
928     C == Global data ==
929     #include "SIZE.h"
930     #include "EEPARAMS.h"
931    
932     C == Routine arguments ==
933     C fld - Field to be printed
934     C lFld - Number of elements in field fld.
935     C index_type - Type of index labelling (I=,J=,...) to use
936     C head - Statement start e.g. phi =
937     C comment - Descriptive comment for field
938     INTEGER lFld
939     Real*8 fld(lFld)
940     INTEGER index_type
941     CHARACTER*(*) head
942     CHARACTER*(*) comment
943     CEndofinterface
944    
945     C == Local variables ==
946     CHARACTER*(MAX_LEN_MBUF) msgBuf
947    
948     WRITE(msgBuf,'(A,A)') head, comment
949     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
950 adcroft 1.8 CALL PRINT_LIST_R8( fld, lFld, index_type, .FALSE., .TRUE., standardMessageUnit )
951 cnh 1.1 WRITE(msgBuf,'(A)') ' ; '
952     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
953     C
954     RETURN
955     END
956    
957     CStartofinterface
958     SUBROUTINE WRITE_FLD_XY_RL( pref ,suff, fld, myIter, myThid)
959     C /==========================================================\
960     C | SUBROUTINE WRITE_FLD_XY_RL |
961     C | o Generic two-dimensional field IO routine. |
962     C |==========================================================|
963     C | Call low-level routines to write a model 2d model field. |
964     C | Handles _RL type data ( generally _RL == REAL*8 ) |
965     C \==========================================================/
966    
967     C == Global variables ==
968     #include "SIZE.h"
969 cnh 1.4 #include "EEPARAMS.h"
970 cnh 1.1 #include "PARAMS.h"
971     #include "DFILE.h"
972    
973     INTEGER IFNBLNK
974     EXTERNAL IFNBLNK
975     INTEGER ILNBLNK
976     EXTERNAL ILNBLNK
977     INTEGER IO_ERRCOUNT
978     EXTERNAL IO_ERRCOUNT
979     CEndofinterface
980    
981     C == Routine arguments ==
982     C pref - File name prefix
983     C suff - File name suffix
984     C fld - Data to be written
985     C myIter - Timestep number
986     C myThid - Thread number calling this routine
987     CHARACTER*(*) pref
988     CHARACTER*(*) suff
989     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
990     INTEGER myIter
991     INTEGER myThid
992    
993     C == Local variables ==
994     C fNamData - Filename building strings
995     C fNamMeta
996     C fileHandle - Handle used to refer to an open DFILE file.
997     C lFilled - Used to indicate the number of elements in the
998     C IO buffer that have been filled.
999     C nXP, nYp - Processes domain extents in X and Y.
1000     C iP, jP, kP - Index in processes coordinates.
1001     C ib - Index in IO buffer
1002     C i, j, k, bi, bj - Loop counters
1003     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
1004     C nDims, dimList - Local and global dataset dimensions
1005     CHARACTER*(MAX_LEN_FNAM) fNamData
1006     CHARACTER*(MAX_LEN_FNAM) fNamMeta
1007     INTEGER fileHandle
1008     INTEGER lFilled
1009     INTEGER nXP, nYP
1010     INTEGER iP, jP, kP, ib
1011     INTEGER i,j, k, bi, bj
1012     INTEGER s1Lo, s1Hi, s2Lo, s2Hi
1013     INTEGER nDims
1014     PARAMETER ( nDims = 2 )
1015     INTEGER dimList(nDims*3)
1016     INTEGER beginIOErrCount, endIOErrCount
1017     CHARACTER*(MAX_LEN_MBUF) msgBuf
1018    
1019     C-- Track IO errors
1020     beginIOErrCount = IO_ERRCOUNT(myThid)
1021    
1022     C-- Build file name
1023     C Name has form 'prefix.pPID.tTID.class.suffix'
1024     C e.g. U.p0001.t0001.data.0000000100
1025     C U.p0001.t0001.meta.0000000100
1026     s1Lo = IFNBLNK(pref)
1027     s1Hi = ILNBLNK(pref)
1028     s2Lo = IFNBLNK(suff)
1029     s2Hi = ILNBLNK(suff)
1030 adcroft 1.8 WRITE( fNamData, '(A,A,A,I4.4,A,I4.4,A)' )
1031     & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1032     & '.p',myProcId,'.t',myThid, '.data'
1033     WRITE( fNamMeta, '(A,A,A,I4.4,A,I4.4,A)' )
1034     & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1035     & '.p',myProcId,'.t',myThid, '.meta'
1036 cnh 1.1
1037     C-- Open file
1038     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
1039     O fileHandle )
1040     IF ( fileHandle .LE. 0 ) GOTO 1000
1041    
1042     C-- Copy data to IO buffer.
1043     C Also regrid it to i,j,k indexing.
1044     nXP=sNx*nSx
1045     nYP=sNy*nSy
1046     lFilled = sNx*nSx * sNy*nSy
1047     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
1048     DO bj=1,nSy
1049     DO bi=1,nSx
1050     DO j=1,sNy
1051     DO i=1,sNx
1052     iP = (bi-1)*sNx+i
1053     jP = (bj-1)*sNy+j
1054     ib = (jP-1)*nXP + iP
1055     ioBuf_R4(ib) = fld(i,j,bi,bj)
1056     ENDDO
1057     ENDDO
1058     ENDDO
1059     ENDDO
1060     ELSE
1061     DO bj=1,nSy
1062     DO bi=1,nSx
1063     DO j=1,sNy
1064     DO i=1,sNx
1065     iP = (bi-1)*sNx+i
1066     jP = (bj-1)*sNy+j
1067     ib = (jP-1)*nXP + iP
1068     ioBuf_R8(ib) = fld(i,j,bi,bj)
1069     ENDDO
1070     ENDDO
1071     ENDDO
1072     ENDDO
1073     ENDIF
1074    
1075     C-- Set local and global data extents
1076     dimList(1) = nXP*nPx
1077     dimList(2) = myXGlobalLo
1078     dimList(3) = myXGlobalLo+nXP-1
1079     dimList(4) = nYP*nPy
1080     dimList(5) = myYGlobalLo
1081     dimList(6) = myYGlobalLo+nYP-1
1082    
1083     C-- Write data
1084     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
1085     CALL DFILE_WRITE_R4( lFilled,
1086     I nDims, dimList,
1087     I fileHandle, myIter, myThid )
1088     ELSE
1089     CALL DFILE_WRITE_R8( lFilled,
1090     I nDims, dimList,
1091     I fileHandle, myIter, myThid )
1092     ENDIF
1093    
1094     C-- Close file
1095     CALL DFILE_CLOSE( fileHandle, myThid )
1096    
1097     C-- Check errors
1098     endIOerrCount = IO_ERRCOUNT(myThid)
1099     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
1100     WRITE(msgBuf,'(A,A,A,A)') '// Wrote file(s) ',
1101     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
1102     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1103     ELSE
1104     WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
1105     CALL PRINT_ERROR( msgBuf, 1 )
1106     ENDIF
1107    
1108     1000 CONTINUE
1109    
1110     RETURN
1111     END
1112    
1113     CStartofinterface
1114     SUBROUTINE WRITE_FLD_XYZ_RL( pref ,suff, fld, myIter, myThid)
1115     C /==========================================================\
1116     C | SUBROUTINE WRITE_FLD_XYZ_RL |
1117     C | o Generic three-dimensional field IO routine. |
1118     C |==========================================================|
1119     C | Call low-level routines to write a model 3d model field. |
1120     C | Handles _RL type data ( generally _RL == REAL*8 ) |
1121     C \==========================================================/
1122    
1123     C == Global variables ==
1124     #include "SIZE.h"
1125 cnh 1.4 #include "EEPARAMS.h"
1126 cnh 1.1 #include "PARAMS.h"
1127     #include "DFILE.h"
1128    
1129     INTEGER IFNBLNK
1130     EXTERNAL IFNBLNK
1131     INTEGER ILNBLNK
1132     EXTERNAL ILNBLNK
1133     INTEGER IO_ERRCOUNT
1134     EXTERNAL IO_ERRCOUNT
1135     CEndofinterface
1136    
1137     C == Routine arguments ==
1138     C pref - File name prefix
1139     C suff - File name suffix
1140     C fld - Data to be written
1141     C myIter - Timestep number
1142     C myThid - Thread number calling this routine
1143     CHARACTER*(*) pref
1144     CHARACTER*(*) suff
1145     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nz,nSx,nSy)
1146     INTEGER myThid
1147     INTEGER myIter
1148    
1149     C == Local variables ==
1150     C fNamData - Filename building strings
1151     C fNamMeta
1152     C fileHandle - Handle used to refer to an open DFILE file.
1153     C lFilled - Used to indicate the number of elements in the
1154     C IO buffer that have been filled.
1155     C nXP, nYp - Processes domain extents in X and Y.
1156     C iP, jP, kP - Index in processes coordinates.
1157     C ib - Index in IO buffer
1158     C i, j, k, bi, bj - Loop counters
1159     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
1160     C nDims, dimList - Local and global dataset dimensions
1161     CHARACTER*(MAX_LEN_FNAM) fNamData
1162     CHARACTER*(MAX_LEN_FNAM) fNamMeta
1163     INTEGER fileHandle
1164     INTEGER lFilled
1165     INTEGER nXP, nYP
1166     INTEGER iP, jP, kP, ib
1167     INTEGER i,j, k, bi, bj
1168     INTEGER s1Lo, s1Hi, s2Lo, s2Hi
1169     INTEGER nDims
1170     PARAMETER ( nDims = 3 )
1171     INTEGER dimList(nDims*3)
1172     INTEGER beginIOErrCount, endIOErrCount
1173     CHARACTER*(MAX_LEN_MBUF) msgBuf
1174    
1175     C-- Track IO errors
1176     beginIOErrCount = IO_ERRCOUNT(myThid)
1177    
1178     C-- Build file name
1179     C Name has form 'prefix.pPID.tTID.class.suffix'
1180     C e.g. U.p0001.t0001.data.0000000100
1181     C U.p0001.t0001.meta.0000000100
1182     s1Lo = IFNBLNK(pref)
1183     s1Hi = ILNBLNK(pref)
1184     s2Lo = IFNBLNK(suff)
1185     s2Hi = ILNBLNK(suff)
1186 adcroft 1.8 WRITE( fNamData, '(A,A,A,I4.4,A,I4.4,A,A)' )
1187     & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1188     & '.p',myProcId,'.t',myThid, '.data'
1189     WRITE( fNamMeta, '(A,A,A,I4.4,A,I4.4,A,A)' )
1190     & pref(s1Lo:s1Hi),suff(s2Lo:s2Hi),
1191     & '.p',myProcId,'.t',myThid, '.meta'
1192 cnh 1.1
1193     C-- Open file
1194     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
1195     O fileHandle )
1196     IF ( fileHandle .LE. 0 ) GOTO 1000
1197    
1198     C-- Copy data to IO buffer.
1199     C Also regrid it to i,j,k indexing.
1200     nXP=sNx*nSx
1201     nYP=sNy*nSy
1202     lFilled = sNx*nSx * sNy*nSy * Nz
1203     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
1204     DO bj=1,nSy
1205     DO bi=1,nSx
1206     DO k=1,Nz
1207     DO j=1,sNy
1208     DO i=1,sNx
1209     iP = (bi-1)*sNx+i
1210     jP = (bj-1)*sNy+j
1211     kP = k
1212     ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP
1213     ioBuf_R4(ib) = fld(i,j,k,bi,bj)
1214     ENDDO
1215     ENDDO
1216     ENDDO
1217     ENDDO
1218     ENDDO
1219     ELSE
1220     DO bj=1,nSy
1221     DO bi=1,nSx
1222     DO k=1,Nz
1223     DO j=1,sNy
1224     DO i=1,sNx
1225     iP = (bi-1)*sNx+i
1226     jP = (bj-1)*sNy+j
1227     kP = k
1228     ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP
1229     ioBuf_R8(ib) = fld(i,j,k,bi,bj)
1230     ENDDO
1231     ENDDO
1232     ENDDO
1233     ENDDO
1234     ENDDO
1235     ENDIF
1236    
1237     C-- Set local and global data extents
1238     dimList(1) = nXP*nPx
1239     dimList(2) = myXGlobalLo
1240     dimList(3) = myXGlobalLo+nXP-1
1241     dimList(4) = nYP*nPy
1242     dimList(5) = myYGlobalLo
1243     dimList(6) = myYGlobalLo+nYP-1
1244     dimList(7) = nZ
1245     dimList(8) = 1
1246     dimList(9) = nZ
1247    
1248     C-- Write data
1249     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
1250     CALL DFILE_WRITE_R4( lFilled,
1251     I nDims, dimList,
1252     I fileHandle, myIter, myThid )
1253     ELSE
1254     CALL DFILE_WRITE_R8( lFilled,
1255     I nDims, dimList,
1256     I fileHandle, myIter, myThid )
1257     ENDIF
1258    
1259     C-- Close file
1260     CALL DFILE_CLOSE( fileHandle, myThid )
1261    
1262     C-- Check errors
1263     endIOerrCount = IO_ERRCOUNT(myThid)
1264     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
1265     WRITE(msgBuf,'(A,A,A,A)') '// Wrote file(s) ',
1266     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
1267     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1268     ELSE
1269     WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
1270     CALL PRINT_ERROR( msgBuf, 1 )
1271     ENDIF
1272    
1273     1000 CONTINUE
1274    
1275     RETURN
1276     END
1277    
1278     CStartofinterface
1279     SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime, myIter, myThid )
1280     C /==========================================================\
1281 cnh 1.4 C | SUBROUTINE WRITE_CHECKPOINT |
1282 cnh 1.1 C | o Controlling routine for IO to write restart file. |
1283     C |==========================================================|
1284     C | Write model checkpoint files for use in restart. |
1285     C | This routine writes both "rolling-checkpoint" files |
1286     C | and permanent checkpoint files. A rolling checkpoint |
1287     C | works through a circular list of suffices. Generally the |
1288     C | circular list has two entries so that a rolling |
1289     C | checkpoint will overwrite the last rolling checkpoint |
1290     C | but one. This is useful for running long jobs without |
1291     C | filling too much disk space. |
1292     C | In a permanent checkpoint data is written suffixed by |
1293     C | the current timestep number. This sort of checkpoint can |
1294     C | be used to provided a snap-shot from which the model |
1295     C | can be rerun. |
1296     C \==========================================================/
1297    
1298     C == Global variables ===
1299     #include "SIZE.h"
1300     #include "EEPARAMS.h"
1301     #include "PARAMS.h"
1302     #include "DYNVARS.h"
1303     #include "CG2D.h"
1304    
1305     LOGICAL DIFFERENT_MULTIPLE
1306     EXTERNAL DIFFERENT_MULTIPLE
1307     INTEGER IO_ERRCOUNT
1308     EXTERNAL IO_ERRCOUNT
1309    
1310     C == Routine arguments ==
1311     C modelEnd - Checkpoint call at end of model run.
1312     C myThid - Thread number for this instance of the routine.
1313     C myIter - Iteration number
1314     C myCurrentTime - Current time of simulation ( s )
1315     LOGICAL modelEnd
1316     INTEGER myThid
1317     INTEGER myIter
1318     REAL myCurrentTime
1319     CEndofinterface
1320    
1321     C == Local variables ==
1322     C suff - Hold suffix part of a filename
1323     C beginIOErrCount - Begin and end IO error counts
1324     C endIOErrCount
1325     C msgBuf - Error message buffer
1326     C permCheckPoint - Flag indicating whether a permanent checkpoint will
1327     C be written.
1328     CHARACTER*(MAX_LEN_FNAM) suff
1329     INTEGER beginIOErrCount
1330     INTEGER endIOErrCount
1331     CHARACTER*(MAX_LEN_MBUF) msgBuf
1332     LOGICAL permCheckPoint
1333    
1334     permCheckPoint = .FALSE.
1335     permCheckPoint=
1336     & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,myCurrentTime-deltaTClock)
1337    
1338     IF (
1339     & (.NOT. modelEnd .AND. (
1340     & permCheckPoint
1341     & .OR.
1342     & DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)
1343     & )
1344     & )
1345     & .OR.
1346     & (
1347     & modelEnd
1348     & .AND. .NOT.
1349     & permCheckPoint
1350     & .AND. .NOT.
1351     & DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)
1352     & )
1353     & ) THEN
1354    
1355     C-- Going to really do some IO. Make everyone except master thread wait.
1356     _BARRIER
1357     _BEGIN_MASTER( myThid )
1358    
1359     C-- Set suffix for this set of data files.
1360     suff = checkPtSuff(nCheckLev)
1361     IF ( permCheckPoint ) THEN
1362     WRITE(suff,'(I10.10)') myIter
1363     ENDIF
1364    
1365     C-- Set IO "context" for writing state
1366     CALL DFILE_SET_RW
1367     CALL DFILE_SET_CONT_ON_ERROR
1368     C Force 64-bit IO
1369     writeBinaryPrec = precFloat64
1370    
1371    
1372     C-- Read IO error counter
1373     beginIOErrCount = IO_ERRCOUNT(myThid)
1374    
1375     C-- Write model fields
1376     C Raw fields
1377     CALL WRITE_FLD_XYZ_RL( 'uVel.',suff, uVel, myIter, myThid)
1378     CALL WRITE_FLD_XYZ_RL( 'gU.',suff, gU, myIter, myThid)
1379     CALL WRITE_FLD_XYZ_RL( 'gUNm1.',suff, gUNm1, myIter, myThid)
1380     CALL WRITE_FLD_XYZ_RL( 'vVel.',suff, vVel, myIter, myThid)
1381     CALL WRITE_FLD_XYZ_RL( 'gV.',suff, gV, myIter, myThid)
1382     CALL WRITE_FLD_XYZ_RL( 'gVNm1.',suff, gVNm1, myIter, myThid)
1383     CALL WRITE_FLD_XYZ_RL( 'theta.',suff, theta, myIter, myThid)
1384     CALL WRITE_FLD_XYZ_RL( 'gT.',suff, gT, myIter, myThid)
1385     CALL WRITE_FLD_XYZ_RL( 'gTNm1.',suff, gTNm1, myIter, myThid)
1386     CALL WRITE_FLD_XYZ_RL( 'salt.',suff, salt, myIter, myThid)
1387     CALL WRITE_FLD_XYZ_RL( 'gS.',suff, gS, myIter, myThid)
1388     CALL WRITE_FLD_XYZ_RL( 'gSNm1.',suff, gSNm1, myIter, myThid)
1389     CALL WRITE_FLD_XY_RL ( 'cg2d_x.',suff, cg2d_x, myIter, myThid)
1390 cnh 1.2 #ifdef ALLOW_CD
1391     CALL WRITE_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
1392     CALL WRITE_FLD_XYZ_RL( 'uVelD.',suff, uVelD, myIter, myThid)
1393     CALL WRITE_FLD_XYZ_RL( 'vVelD.',suff, vVelD, myIter, myThid)
1394     CALL WRITE_FLD_XYZ_RL( 'uNM1.', suff, uNM1, myIter, myThid)
1395     CALL WRITE_FLD_XYZ_RL( 'vNM1.', suff, vNM1, myIter, myThid)
1396     CALL WRITE_FLD_XYZ_RL( 'guCD.', suff, guCD, myIter, myThid)
1397     CALL WRITE_FLD_XYZ_RL( 'gvCD.', suff, gvCD, myIter, myThid)
1398     #endif
1399    
1400 cnh 1.1
1401     C-- Reread IO error counter
1402     endIOErrCount = IO_ERRCOUNT(myThid)
1403    
1404     C-- Check for IO errors
1405     IF ( endIOErrCount .NE. beginIOErrCount ) THEN
1406     WRITE(msgBuf,'(A)') 'S/R WRITE_CHECKPOINT'
1407     CALL PRINT_ERROR( msgBuf, 1 )
1408     WRITE(msgBuf,'(A)') 'Error writing out model checkpoint'
1409     CALL PRINT_ERROR( msgBuf, 1 )
1410     WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1411     CALL PRINT_ERROR( msgBuf, 1 )
1412     ELSE
1413     WRITE(msgBuf,'(A,I10)') '// Model checkpoint written, timestep', myIter
1414     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1415     WRITE(msgBuf,'(A)') ' '
1416     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1417     C Wrote OK so step forward to use next checkpoint in loop.
1418     IF ( .NOT. permCheckPoint ) THEN
1419     nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
1420     ENDIF
1421     ENDIF
1422    
1423     _END_MASTER( myThid )
1424     _BARRIER
1425    
1426     ENDIF
1427    
1428     RETURN
1429     END
1430    
1431     CStartofinterface
1432 adcroft 1.7 SUBROUTINE WRITE_STATE ( forceOutput, myCurrentTime, myIter, myThid )
1433 cnh 1.1 C /==========================================================\
1434     C | SUBROUTINE WRITE_STATE |
1435     C | o Controlling routine for IO to dump model state. |
1436     C |==========================================================|
1437     C | Write model state files for post-processing. This file |
1438     C | includes code for diagnosing W and RHO for output. |
1439     C \==========================================================/
1440    
1441     C == Global variables ===
1442     #include "SIZE.h"
1443     #include "EEPARAMS.h"
1444     #include "PARAMS.h"
1445     #include "DYNVARS.h"
1446     #include "CG2D.h"
1447    
1448     LOGICAL DIFFERENT_MULTIPLE
1449     EXTERNAL DIFFERENT_MULTIPLE
1450     INTEGER IO_ERRCOUNT
1451     EXTERNAL IO_ERRCOUNT
1452    
1453     C == Routine arguments ==
1454     C myThid - Thread number for this instance of the routine.
1455     C myIter - Iteration number
1456     C myCurrentTime - Current time of simulation ( s )
1457 adcroft 1.7 LOGICAL forceOutput
1458 adcroft 1.8 REAL myCurrentTime
1459 cnh 1.1 INTEGER myThid
1460     INTEGER myIter
1461     CEndofinterface
1462    
1463     C == Local variables ==
1464     C suff - Hold suffix part of a filename
1465     C beginIOErrCount - Begin and end IO error counts
1466     C endIOErrCount
1467     C msgBuf - Error message buffer
1468     CHARACTER*(MAX_LEN_FNAM) suff
1469     INTEGER beginIOErrCount
1470     INTEGER endIOErrCount
1471     CHARACTER*(MAX_LEN_MBUF) msgBuf
1472    
1473 adcroft 1.7 IF (
1474 cnh 1.1 & DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,myCurrentTime-deltaTClock)
1475 adcroft 1.7 & .OR. forceOutput
1476     & ) THEN
1477 cnh 1.1
1478     C-- Going to really do some IO. Make everyone except master thread wait.
1479     _BARRIER
1480     _BEGIN_MASTER( myThid )
1481    
1482     C-- Set suffix for this set of data files.
1483     WRITE(suff,'(I10.10)') myIter
1484    
1485     C-- Set IO "context" for writing state
1486     CALL DFILE_SET_RW
1487     CALL DFILE_SET_CONT_ON_ERROR
1488     writeBinaryPrec = writeStatePrec
1489    
1490     C-- Read IO error counter
1491     beginIOErrCount = IO_ERRCOUNT(myThid)
1492    
1493     C-- Write model fields
1494     C Raw fields
1495     CALL WRITE_FLD_XYZ_RL( 'U.',suff, uVel, myIter, myThid)
1496     CALL WRITE_FLD_XYZ_RL( 'V.',suff, vVel, myIter, myThid)
1497     CALL WRITE_FLD_XYZ_RL( 'T.',suff, theta, myIter, myThid)
1498     CALL WRITE_FLD_XYZ_RL( 'S.',suff, salt, myIter, myThid)
1499     CALL WRITE_FLD_XY_RL ( 'H.',suff, cg2d_x, myIter, myThid)
1500     C Hmmm.... what to do atbout these huh
1501     C need to calculate them but remember we are already within a
1502     C _MASTER section. So we can not use multithreaded code.
1503     C We can still code as blocked but the block loop will be
1504     C bj=1,nSy and bi=1,nSx.
1505     C CALL WRITE_FLD_XYZ_RL( 'W.',suff, arr3d , myIter, myThid)
1506     C CALL WRITE_FLD_XYZ_RL( 'RHO.',suff, arr3d , myIter, myThid)
1507     C CALL WRITE_FLD_XYZ_RL('RHOP.',suff, arr3d , myIter, myThid)
1508     C CALL WRITE_FLD_XYZ_RL( 'PH.',suff, arr3d , myIter, myThid)
1509    
1510     C-- Reread IO error counter
1511     endIOErrCount = IO_ERRCOUNT(myThid)
1512    
1513     C-- Check for IO errors
1514     IF ( endIOErrCount .NE. beginIOErrCount ) THEN
1515     WRITE(msgBuf,'(A)') 'S/R WRITE_STATE'
1516     CALL PRINT_ERROR( msgBuf, 1 )
1517     WRITE(msgBuf,'(A)') 'Error writing out model state'
1518     CALL PRINT_ERROR( msgBuf, 1 )
1519     WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1520     CALL PRINT_ERROR( msgBuf, 1 )
1521     ELSE
1522     WRITE(msgBuf,'(A,I10)') '// Model state written, timestep', myIter
1523     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1524     WRITE(msgBuf,'(A)') ' '
1525     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1526     ENDIF
1527    
1528     _END_MASTER( myThid )
1529     _BARRIER
1530 adcroft 1.7
1531     ENDIF
1532 cnh 1.1
1533     RETURN
1534     END
  ViewVC Help
Powered by ViewVC 1.1.22