/[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.3 - (hide annotations) (download)
Tue Jun 9 15:58:36 1998 UTC (26 years ago) by adcroft
Branch: MAIN
Changes since 1.2: +3 -2 lines 
Various corrections:
 o do_gterm_blocking..() is fixed to work with new time-stepping
 o CPP_OPTIONS.h now contains #define ALLOW_CD
1 adcroft 1.3 C $Header: /u/gcmpack/models/MITgcmUV/model/src/read_write.F,v 1.2 1998/06/08 21:43:01 cnh Exp $
2    
3     #include "CPP_OPTIONS.h"
4 cnh 1.1
5     C-- File read_write.F: Routines to handle mid-level I/O interface.
6     C-- Contents
7     C-- o READ_FLD_XY_RL - Read two-dimensional model _RL field.
8     C-- o READ_FLD_XYZ_RL - Read three-dimensional model _RL field.
9     C-- o WRITE_1D_I - Write list of integer values
10     C-- Uses MITgcmUV environment file format.
11     C-- o WRITE_1D_L - Write list of logical values
12     C-- Uses MITgcmUV environment file format.
13     C-- o WRITE_1D_R8 - Write list of real*8 values
14     C-- Uses MITgcmUV environment file format.
15     C-- o WRITE_FLD_XY_RL - Write two-dimensional model _RL field.
16     C-- o WRITE_FLD_XYZ_RL - Write three-dimensional model _RL field.
17     C-- o WRITE_STATE - Write out model state.
18     C-- o WRITE_CHKPT - Write out checkpoint files for restarting.
19    
20     CStartofinterface
21     SUBROUTINE READ_CHECKPOINT ( myIter, myThid )
22     C /==========================================================\
23     C | SUBROUTINE READ_CHECKPOINT |
24     C | o Controlling routine for IO to write restart file. |
25     C |==========================================================|
26     C | Read model checkpoint files for use in restart. |
27     C \==========================================================/
28    
29     C == Global variables ===
30     #include "SIZE.h"
31     #include "EEPARAMS.h"
32     #include "PARAMS.h"
33     #include "DYNVARS.h"
34     #include "CG2D.h"
35    
36     INTEGER IO_ERRCOUNT
37     EXTERNAL IO_ERRCOUNT
38    
39     C == Routine arguments ==
40     C myThid - Thread number for this instance of the routine.
41     C myIter - Iteration number
42     INTEGER myThid
43     INTEGER myIter
44     CEndofinterface
45    
46     C == Local variables ==
47     C suff - Hold suffix part of a filename
48     C beginIOErrCount - Begin and end IO error counts
49     C endIOErrCount
50     C msgBuf - Error message buffer
51     CHARACTER*(MAX_LEN_FNAM) suff
52     INTEGER beginIOErrCount
53     INTEGER endIOErrCount
54     CHARACTER*(MAX_LEN_MBUF) msgBuf
55     LOGICAL permCheckPoint
56    
57     C-- Going to really do some IO. Make everyone except master thread wait.
58     _BARRIER
59     _BEGIN_MASTER( myThid )
60    
61     C-- Set suffix for this set of data files.
62     WRITE(suff,'(I10.10)') myIter
63    
64     C-- Set IO "context" for writing state
65     CALL DFILE_SET_RO
66     CALL DFILE_SET_CONT_ON_ERROR
67     C Force 64-bit IO
68     readBinaryPrec = precFloat64
69    
70    
71     C-- Read IO error counter
72     beginIOErrCount = IO_ERRCOUNT(myThid)
73    
74     C-- Write model fields
75     C Raw fields
76     CALL READ_FLD_XYZ_RL( 'uVel.',suff, uVel, myIter, myThid)
77     CALL READ_FLD_XYZ_RL( 'gU.',suff, gU, myIter, myThid)
78     CALL READ_FLD_XYZ_RL( 'gUNm1.',suff, gUNm1, myIter, myThid)
79     CALL READ_FLD_XYZ_RL( 'vVel.',suff, vVel, myIter, myThid)
80     CALL READ_FLD_XYZ_RL( 'gV.',suff, gV, myIter, myThid)
81     CALL READ_FLD_XYZ_RL( 'gVNm1.',suff, gVNm1, myIter, myThid)
82     CALL READ_FLD_XYZ_RL( 'theta.',suff, theta, myIter, myThid)
83     CALL READ_FLD_XYZ_RL( 'gT.',suff, gT, myIter, myThid)
84     CALL READ_FLD_XYZ_RL( 'gTNm1.',suff, gTNm1, myIter, myThid)
85     CALL READ_FLD_XYZ_RL( 'salt.',suff, salt, myIter, myThid)
86     CALL READ_FLD_XYZ_RL( 'gS.',suff, gS, myIter, myThid)
87     CALL READ_FLD_XYZ_RL( 'gSNm1.',suff, gSNm1, myIter, myThid)
88     CALL READ_FLD_XY_RL ( 'cg2d_x.',suff, cg2d_x, myIter, myThid)
89 cnh 1.2 #ifdef ALLOW_CD
90     CALL READ_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
91     CALL READ_FLD_XYZ_RL( 'uVelD.',suff, uVelD, myIter, myThid)
92     CALL READ_FLD_XYZ_RL( 'vVelD.',suff, vVelD, myIter, myThid)
93     CALL READ_FLD_XYZ_RL( 'uNM1.', suff, uNM1, myIter, myThid)
94     CALL READ_FLD_XYZ_RL( 'vNM1.', suff, vNM1, myIter, myThid)
95     CALL READ_FLD_XYZ_RL( 'guCD.', suff, guCD, myIter, myThid)
96     CALL READ_FLD_XYZ_RL( 'gvCD.', suff, gvCD, myIter, myThid)
97     #endif
98 cnh 1.1
99     C-- Reread IO error counter
100     endIOErrCount = IO_ERRCOUNT(myThid)
101    
102     C-- Check for IO errors
103     IF ( endIOErrCount .NE. beginIOErrCount ) THEN
104     WRITE(msgBuf,'(A)') 'S/R READ_CHECKPOINT'
105     CALL PRINT_ERROR( msgBuf, 1 )
106     WRITE(msgBuf,'(A)') 'Error reading in model checkpoint'
107     CALL PRINT_ERROR( msgBuf, 1 )
108     WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
109     CALL PRINT_ERROR( msgBuf, 1 )
110     STOP 'ABNORMAL END: S/R READ_CHECKPOINT'
111     ELSE
112     WRITE(msgBuf,'(A,I10)') '// Model checkpoint read, timestep', myIter
113     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
114     WRITE(msgBuf,'(A)') ' '
115     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
116     ENDIF
117    
118     _END_MASTER( myThid )
119     _BARRIER
120    
121     C-- Fill in edge regions
122     _EXCH_XYZ_R8(uVel , myThid )
123     _EXCH_XYZ_R8(gu , myThid )
124     _EXCH_XYZ_R8(guNM1 , myThid )
125     _EXCH_XYZ_R8(vVel , myThid )
126     _EXCH_XYZ_R8(gv , myThid )
127     _EXCH_XYZ_R8(gvNM1 , myThid )
128     _EXCH_XYZ_R8(theta , myThid )
129     _EXCH_XYZ_R8(gt , myThid )
130     _EXCH_XYZ_R8(gtNM1 , myThid )
131     _EXCH_XYZ_R8(salt , myThid )
132     _EXCH_XYZ_R8(gs , myThid )
133     _EXCH_XYZ_R8(gsNM1 , myThid )
134     _EXCH_XY_R8 (cg2d_x, myThid )
135    
136     RETURN
137     END
138    
139     CStartofinterface
140     SUBROUTINE READ_FLD_XY_RL( pref ,suff, fld, myIter, myThid)
141     C /==========================================================\
142     C | SUBROUTINE READ_FLD_XY_RL |
143     C | o Generic two-dimensional field IO routine. |
144     C |==========================================================|
145     C | Call low-level routines to read a 2d model field. |
146     C | Handles _RL type data ( generally _RL == REAL*8 ) |
147     C \==========================================================/
148    
149     C == Global variables ==
150     #include "SIZE.h"
151     #include "PARAMS.h"
152     #include "EEPARAMS.h"
153     #include "DFILE.h"
154    
155     INTEGER IFNBLNK
156     EXTERNAL IFNBLNK
157     INTEGER ILNBLNK
158     EXTERNAL ILNBLNK
159     INTEGER IO_ERRCOUNT
160     EXTERNAL IO_ERRCOUNT
161     CEndofinterface
162    
163     C == Routine arguments ==
164     C pref - File name prefix
165     C suff - File name suffix
166     C fld - Array to be filled
167     C myIter - Timestep number
168     C myThid - Thread number calling this routine
169     CHARACTER*(*) pref
170     CHARACTER*(*) suff
171     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
172     INTEGER myIter
173     INTEGER myThid
174    
175     C == Local variables ==
176     C fNamData - Filename building strings
177     C fNamMeta
178     C fileHandle - Handle used to refer to an open DFILE file.
179     C lFilled - Used to indicate the number of elements in the
180     C IO buffer that have been filled.
181     C nXP, nYp - Processes domain extents in X and Y.
182     C iP, jP, kP - Index in processes coordinates.
183     C ib - Index in IO buffer
184     C i, j, k, bi, bj - Loop counters
185     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
186     C nDims, dimList - Local and global dataset dimensions
187     CHARACTER*(MAX_LEN_FNAM) fNamData
188     CHARACTER*(MAX_LEN_FNAM) fNamMeta
189     INTEGER fileHandle
190     INTEGER lFilled
191     INTEGER nXP, nYP
192     INTEGER iP, jP, kP, ib
193     INTEGER i,j, k, bi, bj
194     INTEGER s1Lo, s1Hi, s2Lo, s2Hi
195     INTEGER nDims
196     PARAMETER ( nDims = 2 )
197     INTEGER dimList(nDims*3)
198     INTEGER beginIOErrCount, endIOErrCount
199     CHARACTER*(MAX_LEN_MBUF) msgBuf
200    
201     C-- Track IO errors
202     beginIOErrCount = IO_ERRCOUNT(myThid)
203    
204     C-- Build file name
205     C Name has form 'prefix.suffix'
206     C e.g. U.0000000100
207     C U.0000000100
208     s1Lo = IFNBLNK(pref)
209     s1Hi = ILNBLNK(pref)
210     s2Lo = IFNBLNK(suff)
211     s2Hi = ILNBLNK(suff)
212     WRITE( fNamData, '(A,A)' )
213     & pref(s1Lo:s1Hi),
214     & suff(s2Lo:s2Hi)
215     WRITE( fNamMeta, '(A,A)' )
216     & pref(s1Lo:s1Hi),
217     & suff(s2Lo:s2Hi)
218    
219     C-- Open file
220     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
221     O fileHandle )
222     IF ( fileHandle .LE. 0 ) GOTO 1000
223    
224     C-- Set local and global data extents
225     nXP=sNx*nSx
226     nYP=sNy*nSy
227     lFilled = sNx*nSx * sNy*nSy
228     dimList(1) = nXP*nPx
229     dimList(2) = myXGlobalLo
230     dimList(3) = myXGlobalLo+nXP-1
231     dimList(4) = nYP*nPy
232     dimList(5) = myYGlobalLo
233     dimList(6) = myYGlobalLo+nYP-1
234    
235     C-- Read data
236     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
237     CALL DFILE_READ_R4( lFilled,
238     I fileHandle, myThid )
239     ELSE
240     CALL DFILE_READ_R8( lFilled,
241     I fileHandle, myThid )
242     ENDIF
243    
244     C-- Copy data from IO buffer.
245     C Also regrid it to i,j,k indexing.
246     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
247     DO bj=1,nSy
248     DO bi=1,nSx
249     DO j=1,sNy
250     DO i=1,sNx
251     iP = (bi-1)*sNx+i
252     jP = (bj-1)*sNy+j
253     ib = (jP-1)*nXP + iP
254     fld(i,j,bi,bj) = ioBuf_R4(ib)
255     ENDDO
256     ENDDO
257     ENDDO
258     ENDDO
259     ELSE
260     DO bj=1,nSy
261     DO bi=1,nSx
262     DO j=1,sNy
263     DO i=1,sNx
264     iP = (bi-1)*sNx+i
265     jP = (bj-1)*sNy+j
266     ib = (jP-1)*nXP + iP
267     fld(i,j,bi,bj) = ioBuf_R8(ib)
268     ENDDO
269     ENDDO
270     ENDDO
271     ENDDO
272     ENDIF
273    
274     C-- Close file
275     CALL DFILE_CLOSE( fileHandle, myThid )
276    
277     C-- Check errors
278     endIOerrCount = IO_ERRCOUNT(myThid)
279     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
280     WRITE(msgBuf,'(A,A,A,A)') '// Read file(s) ',
281     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
282     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
283     ELSE
284     WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
285     CALL PRINT_ERROR( msgBuf, 1 )
286     ENDIF
287    
288     1000 CONTINUE
289    
290     RETURN
291     END
292    
293     CStartofinterface
294     SUBROUTINE READ_FLD_XYZ_RL( pref ,suff, fld, myIter, myThid)
295     C /==========================================================\
296     C | SUBROUTINE READ_FLD_XYZ_RL |
297     C | o Generic three-dimensional field IO routine. |
298     C |==========================================================|
299     C | Call low-level routines to read a 3d model field. |
300     C | Handles _RL type data ( generally _RL == REAL*8 ) |
301     C \==========================================================/
302    
303     C == Global variables ==
304     #include "SIZE.h"
305     #include "PARAMS.h"
306     #include "EEPARAMS.h"
307     #include "DFILE.h"
308    
309     INTEGER IFNBLNK
310     EXTERNAL IFNBLNK
311     INTEGER ILNBLNK
312     EXTERNAL ILNBLNK
313     INTEGER IO_ERRCOUNT
314     EXTERNAL IO_ERRCOUNT
315     CEndofinterface
316    
317     C == Routine arguments ==
318     C pref - File name prefix
319     C suff - File name suffix
320     C fld - Array to be filled
321     C myIter - Timestep number
322     C myThid - Thread number calling this routine
323     CHARACTER*(*) pref
324     CHARACTER*(*) suff
325     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nZ,nSx,nSy)
326     INTEGER myIter
327     INTEGER myThid
328    
329     C == Local variables ==
330     C fNamData - Filename building strings
331     C fNamMeta
332     C fileHandle - Handle used to refer to an open DFILE file.
333     C lFilled - Used to indicate the number of elements in the
334     C IO buffer that have been filled.
335     C nXP, nYp - Processes domain extents in X and Y.
336     C iP, jP, kP - Index in processes coordinates.
337     C ib - Index in IO buffer
338     C i, j, k, bi, bj - Loop counters
339     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
340     C nDims, dimList - Local and global dataset dimensions
341     CHARACTER*(MAX_LEN_FNAM) fNamData
342     CHARACTER*(MAX_LEN_FNAM) fNamMeta
343     INTEGER fileHandle
344     INTEGER lFilled
345     INTEGER nXP, nYP
346     INTEGER iP, jP, kP, ib
347     INTEGER i,j, k, bi, bj
348     INTEGER s1Lo, s1Hi, s2Lo, s2Hi
349     INTEGER nDims
350     PARAMETER ( nDims = 3 )
351     INTEGER dimList(nDims*3)
352     INTEGER beginIOErrCount, endIOErrCount
353     CHARACTER*(MAX_LEN_MBUF) msgBuf
354    
355     C-- Track IO errors
356     beginIOErrCount = IO_ERRCOUNT(myThid)
357    
358     C-- Build file name
359     C Name has form 'prefix.suffix'
360     C e.g. U.0000000100
361     C U.0000000100
362     s1Lo = IFNBLNK(pref)
363     s1Hi = ILNBLNK(pref)
364     s2Lo = IFNBLNK(suff)
365     s2Hi = ILNBLNK(suff)
366     WRITE( fNamData, '(A,A)' )
367     & pref(s1Lo:s1Hi),
368     & suff(s2Lo:s2Hi)
369     WRITE( fNamMeta, '(A,A)' )
370     & pref(s1Lo:s1Hi),
371     & suff(s2Lo:s2Hi)
372    
373     C-- Open file
374     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
375     O fileHandle )
376     IF ( fileHandle .LE. 0 ) GOTO 1000
377    
378     C-- Set local and global data extents
379     nXP=sNx*nSx
380     nYP=sNy*nSy
381     lFilled = sNx*nSx * sNy*nSy * nZ
382     dimList(1) = nXP*nPx
383     dimList(2) = myXGlobalLo
384     dimList(3) = myXGlobalLo+nXP-1
385     dimList(4) = nYP*nPy
386     dimList(5) = myYGlobalLo
387     dimList(6) = myYGlobalLo+nYP-1
388     dimList(7) = nZ
389     dimList(8) = 1
390     dimList(9) = nZ
391    
392     C-- Read data
393     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
394     CALL DFILE_READ_R4( lFilled,
395     I fileHandle, myThid )
396     ELSE
397     CALL DFILE_READ_R8( lFilled,
398     I fileHandle, myThid )
399     ENDIF
400    
401     C-- Copy data from IO buffer.
402     C Also regrid it to i,j,k indexing.
403     IF ( readBinaryPrec .EQ. precFloat32 ) THEN
404     DO bj=1,nSy
405     DO bi=1,nSx
406     DO K=1,nZ
407     DO j=1,sNy
408     DO i=1,sNx
409     iP = (bi-1)*sNx+i
410     jP = (bj-1)*sNy+j
411     kP = K
412     ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP
413     fld(i,j,k,bi,bj) = ioBuf_R4(ib)
414     ENDDO
415     ENDDO
416     ENDDO
417     ENDDO
418     ENDDO
419     ELSE
420     DO bj=1,nSy
421     DO bi=1,nSx
422     DO K=1,nZ
423     DO j=1,sNy
424     DO i=1,sNx
425     iP = (bi-1)*sNx+i
426     jP = (bj-1)*sNy+j
427     kP = K
428     ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP
429     fld(i,j,k,bi,bj) = ioBuf_R8(ib)
430     ENDDO
431     ENDDO
432     ENDDO
433     ENDDO
434     ENDDO
435     ENDIF
436    
437     C-- Close file
438     CALL DFILE_CLOSE( fileHandle, myThid )
439    
440     C-- Check errors
441     endIOerrCount = IO_ERRCOUNT(myThid)
442     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
443     WRITE(msgBuf,'(A,A,A,A)') '// Read file(s) ',
444     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
445     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
446     ELSE
447     WRITE(msgBuf,'(A,A,A)') 'Error reading file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
448     CALL PRINT_ERROR( msgBuf, 1 )
449     ENDIF
450    
451     1000 CONTINUE
452    
453     RETURN
454     END
455    
456     CStartofinterface
457     SUBROUTINE WRITE_1D_I( fld, lFld, index_type, head, comment )
458     C /==========================================================\
459     C | o SUBROUTINE WRITE_1D_I |
460     C | Controls formatted, tabular I/O for a one-dimensional |
461     C | INTEGER field. |
462     C |==========================================================|
463     C | This routine produces a standard format for list |
464     C | one-dimensional INTEGER data in textual form. The format |
465     C | is designed to be readily parsed by a post-processing |
466     C | utility. |
467     C \==========================================================/
468    
469     C == Global data ==
470     #include "SIZE.h"
471     #include "EEPARAMS.h"
472    
473     C == Routine arguments ==
474     C fld - Field to be printed
475     C lFld - Number of elements in field fld.
476     C index_type - Type of index labelling (I=,J=,...) to use
477     C head - Statement start e.g. phi =
478     C comment - Descriptive comment for field
479     INTEGER lFld
480     INTEGER fld(lFld)
481     INTEGER index_type
482     CHARACTER*(*) head
483     CHARACTER*(*) comment
484     CEndofinterface
485    
486     C == Local variables ==
487     CHARACTER*(MAX_LEN_MBUF) msgBuf
488    
489     WRITE(msgBuf,'(A,A)') head, comment
490     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
491     CALL PRINT_LIST_I( fld, lFld, index_type, standardMessageUnit )
492     WRITE(msgBuf,'(A)') ' ; '
493     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
494     C
495     RETURN
496     END
497    
498     CStartofinterface
499     SUBROUTINE WRITE_1D_L( fld, lFld, index_type, head, comment )
500     C /==========================================================\
501     C | o SUBROUTINE WRITE_1D_L |
502     C | Controls formatted, tabular I/O for a one-dimensional |
503     C | LOGICAL field. |
504     C |==========================================================|
505     C | This routine produces a standard format for list |
506     C | one-dimensional LOGICAL data in textual form. The format |
507     C | is designed to be readily parsed by a post-processing |
508     C | utility. |
509     C \==========================================================/
510    
511     C == Global data ==
512     #include "SIZE.h"
513     #include "EEPARAMS.h"
514    
515     C == Routine arguments ==
516     C fld - Field to be printed
517     C lFld - Number of elements in field fld.
518     C index_type - Type of index labelling (I=,J=,...) to use
519     C head - Statement start e.g. phi =
520     C comment - Descriptive comment for field
521     INTEGER lFld
522     LOGICAL fld(lFld)
523     INTEGER index_type
524     CHARACTER*(*) head
525     CHARACTER*(*) comment
526     CEndofinterface
527    
528     C == Local variables ==
529     CHARACTER*(MAX_LEN_MBUF) msgBuf
530    
531     WRITE(msgBuf,'(A,A)') head, comment
532     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
533     CALL PRINT_LIST_L( fld, lFld, index_type, standardMessageUnit )
534     WRITE(msgBuf,'(A)') ' ; '
535     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
536     C
537     RETURN
538     END
539    
540     CStartofinterface
541     SUBROUTINE WRITE_1D_R8( fld, lFld, index_type, head, comment )
542     C /==========================================================\
543     C | o SUBROUTINE WRITE_1D_R8 |
544     C | Controls formatted, tabular I/O for a one-dimensional |
545     C | real*8 field. |
546     C |==========================================================|
547     C | This routine produces a standard format for list |
548     C | one-dimensional real*8 data in textual form. The format |
549     C | is designed to be readilya parsed by a post-processing |
550     C | utility. |
551     C \==========================================================/
552    
553     C == Global data ==
554     #include "SIZE.h"
555     #include "EEPARAMS.h"
556    
557     C == Routine arguments ==
558     C fld - Field to be printed
559     C lFld - Number of elements in field fld.
560     C index_type - Type of index labelling (I=,J=,...) to use
561     C head - Statement start e.g. phi =
562     C comment - Descriptive comment for field
563     INTEGER lFld
564     Real*8 fld(lFld)
565     INTEGER index_type
566     CHARACTER*(*) head
567     CHARACTER*(*) comment
568     CEndofinterface
569    
570     C == Local variables ==
571     CHARACTER*(MAX_LEN_MBUF) msgBuf
572    
573     WRITE(msgBuf,'(A,A)') head, comment
574     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
575     CALL PRINT_LIST_R8( fld, lFld, index_type, standardMessageUnit )
576     WRITE(msgBuf,'(A)') ' ; '
577     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT , 1)
578     C
579     RETURN
580     END
581    
582     CStartofinterface
583     SUBROUTINE WRITE_FLD_XY_RL( pref ,suff, fld, myIter, myThid)
584     C /==========================================================\
585     C | SUBROUTINE WRITE_FLD_XY_RL |
586     C | o Generic two-dimensional field IO routine. |
587     C |==========================================================|
588     C | Call low-level routines to write a model 2d model field. |
589     C | Handles _RL type data ( generally _RL == REAL*8 ) |
590     C \==========================================================/
591    
592     C == Global variables ==
593     #include "SIZE.h"
594     #include "PARAMS.h"
595     #include "EEPARAMS.h"
596     #include "DFILE.h"
597    
598     INTEGER IFNBLNK
599     EXTERNAL IFNBLNK
600     INTEGER ILNBLNK
601     EXTERNAL ILNBLNK
602     INTEGER IO_ERRCOUNT
603     EXTERNAL IO_ERRCOUNT
604     CEndofinterface
605    
606     C == Routine arguments ==
607     C pref - File name prefix
608     C suff - File name suffix
609     C fld - Data to be written
610     C myIter - Timestep number
611     C myThid - Thread number calling this routine
612     CHARACTER*(*) pref
613     CHARACTER*(*) suff
614     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
615     INTEGER myIter
616     INTEGER myThid
617    
618     C == Local variables ==
619     C fNamData - Filename building strings
620     C fNamMeta
621     C fileHandle - Handle used to refer to an open DFILE file.
622     C lFilled - Used to indicate the number of elements in the
623     C IO buffer that have been filled.
624     C nXP, nYp - Processes domain extents in X and Y.
625     C iP, jP, kP - Index in processes coordinates.
626     C ib - Index in IO buffer
627     C i, j, k, bi, bj - Loop counters
628     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
629     C nDims, dimList - Local and global dataset dimensions
630     CHARACTER*(MAX_LEN_FNAM) fNamData
631     CHARACTER*(MAX_LEN_FNAM) fNamMeta
632     INTEGER fileHandle
633     INTEGER lFilled
634     INTEGER nXP, nYP
635     INTEGER iP, jP, kP, ib
636     INTEGER i,j, k, bi, bj
637     INTEGER s1Lo, s1Hi, s2Lo, s2Hi
638     INTEGER nDims
639     PARAMETER ( nDims = 2 )
640     INTEGER dimList(nDims*3)
641     INTEGER beginIOErrCount, endIOErrCount
642     CHARACTER*(MAX_LEN_MBUF) msgBuf
643    
644     C-- Track IO errors
645     beginIOErrCount = IO_ERRCOUNT(myThid)
646    
647     C-- Build file name
648     C Name has form 'prefix.pPID.tTID.class.suffix'
649     C e.g. U.p0001.t0001.data.0000000100
650     C U.p0001.t0001.meta.0000000100
651     s1Lo = IFNBLNK(pref)
652     s1Hi = ILNBLNK(pref)
653     s2Lo = IFNBLNK(suff)
654     s2Hi = ILNBLNK(suff)
655     WRITE( fNamData, '(A,A,I4.4,A,I4.4,A,A)' )
656     & pref(s1Lo:s1Hi),
657     & 'p',myProcId,'.t',myThid, '.data.',
658     & suff(s2Lo:s2Hi)
659     WRITE( fNamMeta, '(A,A,I4.4,A,I4.4,A,A)' )
660     & pref(s1Lo:s1Hi),
661     & 'p',myProcId,'.t',myThid, '.meta.',
662     & suff(s2Lo:s2Hi)
663    
664     C-- Open file
665     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
666     O fileHandle )
667     IF ( fileHandle .LE. 0 ) GOTO 1000
668    
669     C-- Copy data to IO buffer.
670     C Also regrid it to i,j,k indexing.
671     nXP=sNx*nSx
672     nYP=sNy*nSy
673     lFilled = sNx*nSx * sNy*nSy
674     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
675     DO bj=1,nSy
676     DO bi=1,nSx
677     DO j=1,sNy
678     DO i=1,sNx
679     iP = (bi-1)*sNx+i
680     jP = (bj-1)*sNy+j
681     ib = (jP-1)*nXP + iP
682     ioBuf_R4(ib) = fld(i,j,bi,bj)
683     ENDDO
684     ENDDO
685     ENDDO
686     ENDDO
687     ELSE
688     DO bj=1,nSy
689     DO bi=1,nSx
690     DO j=1,sNy
691     DO i=1,sNx
692     iP = (bi-1)*sNx+i
693     jP = (bj-1)*sNy+j
694     ib = (jP-1)*nXP + iP
695     ioBuf_R8(ib) = fld(i,j,bi,bj)
696     ENDDO
697     ENDDO
698     ENDDO
699     ENDDO
700     ENDIF
701    
702     C-- Set local and global data extents
703     dimList(1) = nXP*nPx
704     dimList(2) = myXGlobalLo
705     dimList(3) = myXGlobalLo+nXP-1
706     dimList(4) = nYP*nPy
707     dimList(5) = myYGlobalLo
708     dimList(6) = myYGlobalLo+nYP-1
709    
710     C-- Write data
711     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
712     CALL DFILE_WRITE_R4( lFilled,
713     I nDims, dimList,
714     I fileHandle, myIter, myThid )
715     ELSE
716     CALL DFILE_WRITE_R8( lFilled,
717     I nDims, dimList,
718     I fileHandle, myIter, myThid )
719     ENDIF
720    
721     C-- Close file
722     CALL DFILE_CLOSE( fileHandle, myThid )
723    
724     C-- Check errors
725     endIOerrCount = IO_ERRCOUNT(myThid)
726     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
727     WRITE(msgBuf,'(A,A,A,A)') '// Wrote file(s) ',
728     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
729     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
730     ELSE
731     WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
732     CALL PRINT_ERROR( msgBuf, 1 )
733     ENDIF
734    
735     1000 CONTINUE
736    
737     RETURN
738     END
739    
740     CStartofinterface
741     SUBROUTINE WRITE_FLD_XYZ_RL( pref ,suff, fld, myIter, myThid)
742     C /==========================================================\
743     C | SUBROUTINE WRITE_FLD_XYZ_RL |
744     C | o Generic three-dimensional field IO routine. |
745     C |==========================================================|
746     C | Call low-level routines to write a model 3d model field. |
747     C | Handles _RL type data ( generally _RL == REAL*8 ) |
748     C \==========================================================/
749    
750     C == Global variables ==
751     #include "SIZE.h"
752     #include "PARAMS.h"
753     #include "EEPARAMS.h"
754     #include "DFILE.h"
755    
756     INTEGER IFNBLNK
757     EXTERNAL IFNBLNK
758     INTEGER ILNBLNK
759     EXTERNAL ILNBLNK
760     INTEGER IO_ERRCOUNT
761     EXTERNAL IO_ERRCOUNT
762     CEndofinterface
763    
764     C == Routine arguments ==
765     C pref - File name prefix
766     C suff - File name suffix
767     C fld - Data to be written
768     C myIter - Timestep number
769     C myThid - Thread number calling this routine
770     CHARACTER*(*) pref
771     CHARACTER*(*) suff
772     _RL fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nz,nSx,nSy)
773     INTEGER myThid
774     INTEGER myIter
775    
776     C == Local variables ==
777     C fNamData - Filename building strings
778     C fNamMeta
779     C fileHandle - Handle used to refer to an open DFILE file.
780     C lFilled - Used to indicate the number of elements in the
781     C IO buffer that have been filled.
782     C nXP, nYp - Processes domain extents in X and Y.
783     C iP, jP, kP - Index in processes coordinates.
784     C ib - Index in IO buffer
785     C i, j, k, bi, bj - Loop counters
786     C s1Lo, s1Hi, s2Lo, s2Hi - Substring indices
787     C nDims, dimList - Local and global dataset dimensions
788     CHARACTER*(MAX_LEN_FNAM) fNamData
789     CHARACTER*(MAX_LEN_FNAM) fNamMeta
790     INTEGER fileHandle
791     INTEGER lFilled
792     INTEGER nXP, nYP
793     INTEGER iP, jP, kP, ib
794     INTEGER i,j, k, bi, bj
795     INTEGER s1Lo, s1Hi, s2Lo, s2Hi
796     INTEGER nDims
797     PARAMETER ( nDims = 3 )
798     INTEGER dimList(nDims*3)
799     INTEGER beginIOErrCount, endIOErrCount
800     CHARACTER*(MAX_LEN_MBUF) msgBuf
801    
802     C-- Track IO errors
803     beginIOErrCount = IO_ERRCOUNT(myThid)
804    
805     C-- Build file name
806     C Name has form 'prefix.pPID.tTID.class.suffix'
807     C e.g. U.p0001.t0001.data.0000000100
808     C U.p0001.t0001.meta.0000000100
809     s1Lo = IFNBLNK(pref)
810     s1Hi = ILNBLNK(pref)
811     s2Lo = IFNBLNK(suff)
812     s2Hi = ILNBLNK(suff)
813     WRITE( fNamData, '(A,A,I4.4,A,I4.4,A,A)' )
814     & pref(s1Lo:s1Hi),
815     & 'p',myProcId,'.t',myThid, '.data.',
816     & suff(s2Lo:s2Hi)
817     WRITE( fNamMeta, '(A,A,I4.4,A,I4.4,A,A)' )
818     & pref(s1Lo:s1Hi),
819     & 'p',myProcId,'.t',myThid, '.meta.',
820     & suff(s2Lo:s2Hi)
821    
822     C-- Open file
823     CALL DFILE_OPEN( fNamData, fNamMeta, myThid,
824     O fileHandle )
825     IF ( fileHandle .LE. 0 ) GOTO 1000
826    
827     C-- Copy data to IO buffer.
828     C Also regrid it to i,j,k indexing.
829     nXP=sNx*nSx
830     nYP=sNy*nSy
831     lFilled = sNx*nSx * sNy*nSy * Nz
832     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
833     DO bj=1,nSy
834     DO bi=1,nSx
835     DO k=1,Nz
836     DO j=1,sNy
837     DO i=1,sNx
838     iP = (bi-1)*sNx+i
839     jP = (bj-1)*sNy+j
840     kP = k
841     ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP
842     ioBuf_R4(ib) = fld(i,j,k,bi,bj)
843     ENDDO
844     ENDDO
845     ENDDO
846     ENDDO
847     ENDDO
848     ELSE
849     DO bj=1,nSy
850     DO bi=1,nSx
851     DO k=1,Nz
852     DO j=1,sNy
853     DO i=1,sNx
854     iP = (bi-1)*sNx+i
855     jP = (bj-1)*sNy+j
856     kP = k
857     ib = (kP-1)*nXP*nYP + (jP-1)*nXP + iP
858     ioBuf_R8(ib) = fld(i,j,k,bi,bj)
859     ENDDO
860     ENDDO
861     ENDDO
862     ENDDO
863     ENDDO
864     ENDIF
865    
866     C-- Set local and global data extents
867     dimList(1) = nXP*nPx
868     dimList(2) = myXGlobalLo
869     dimList(3) = myXGlobalLo+nXP-1
870     dimList(4) = nYP*nPy
871     dimList(5) = myYGlobalLo
872     dimList(6) = myYGlobalLo+nYP-1
873     dimList(7) = nZ
874     dimList(8) = 1
875     dimList(9) = nZ
876    
877     C-- Write data
878     IF ( writeBinaryPrec .EQ. precFloat32 ) THEN
879     CALL DFILE_WRITE_R4( lFilled,
880     I nDims, dimList,
881     I fileHandle, myIter, myThid )
882     ELSE
883     CALL DFILE_WRITE_R8( lFilled,
884     I nDims, dimList,
885     I fileHandle, myIter, myThid )
886     ENDIF
887    
888     C-- Close file
889     CALL DFILE_CLOSE( fileHandle, myThid )
890    
891     C-- Check errors
892     endIOerrCount = IO_ERRCOUNT(myThid)
893     IF ( endIOErrCount .EQ. beginIOErrCount ) THEN
894     WRITE(msgBuf,'(A,A,A,A)') '// Wrote file(s) ',
895     & pref(s1Lo:s1Hi),'*',suff(s2Lo:s2Hi)
896     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
897     ELSE
898     WRITE(msgBuf,'(A,A,A)') 'Error writing file ',pref(s1Lo:s1Hi),suff(s2Lo:s2Hi)
899     CALL PRINT_ERROR( msgBuf, 1 )
900     ENDIF
901    
902     1000 CONTINUE
903    
904     RETURN
905     END
906    
907     CStartofinterface
908     SUBROUTINE WRITE_CHECKPOINT ( modelEnd, myCurrentTime, myIter, myThid )
909     C /==========================================================\
910     C | SUBROUTINE WRITE_CHKPT |
911     C | o Controlling routine for IO to write restart file. |
912     C |==========================================================|
913     C | Write model checkpoint files for use in restart. |
914     C | This routine writes both "rolling-checkpoint" files |
915     C | and permanent checkpoint files. A rolling checkpoint |
916     C | works through a circular list of suffices. Generally the |
917     C | circular list has two entries so that a rolling |
918     C | checkpoint will overwrite the last rolling checkpoint |
919     C | but one. This is useful for running long jobs without |
920     C | filling too much disk space. |
921     C | In a permanent checkpoint data is written suffixed by |
922     C | the current timestep number. This sort of checkpoint can |
923     C | be used to provided a snap-shot from which the model |
924     C | can be rerun. |
925     C \==========================================================/
926    
927     C == Global variables ===
928     #include "SIZE.h"
929     #include "EEPARAMS.h"
930     #include "PARAMS.h"
931     #include "DYNVARS.h"
932     #include "CG2D.h"
933    
934     LOGICAL DIFFERENT_MULTIPLE
935     EXTERNAL DIFFERENT_MULTIPLE
936     INTEGER IO_ERRCOUNT
937     EXTERNAL IO_ERRCOUNT
938    
939     C == Routine arguments ==
940     C modelEnd - Checkpoint call at end of model run.
941     C myThid - Thread number for this instance of the routine.
942     C myIter - Iteration number
943     C myCurrentTime - Current time of simulation ( s )
944     LOGICAL modelEnd
945     INTEGER myThid
946     INTEGER myIter
947     REAL myCurrentTime
948     CEndofinterface
949    
950     C == Local variables ==
951     C suff - Hold suffix part of a filename
952     C beginIOErrCount - Begin and end IO error counts
953     C endIOErrCount
954     C msgBuf - Error message buffer
955     C permCheckPoint - Flag indicating whether a permanent checkpoint will
956     C be written.
957     CHARACTER*(MAX_LEN_FNAM) suff
958     INTEGER beginIOErrCount
959     INTEGER endIOErrCount
960     CHARACTER*(MAX_LEN_MBUF) msgBuf
961     LOGICAL permCheckPoint
962    
963     permCheckPoint = .FALSE.
964     permCheckPoint=
965     & DIFFERENT_MULTIPLE(pChkptFreq,myCurrentTime,myCurrentTime-deltaTClock)
966    
967     IF (
968     & (.NOT. modelEnd .AND. (
969     & permCheckPoint
970     & .OR.
971     & DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)
972     & )
973     & )
974     & .OR.
975     & (
976     & modelEnd
977     & .AND. .NOT.
978     & permCheckPoint
979     & .AND. .NOT.
980     & DIFFERENT_MULTIPLE(chkptFreq,myCurrentTime,myCurrentTime-deltaTClock)
981     & )
982     & ) THEN
983    
984     C-- Going to really do some IO. Make everyone except master thread wait.
985     _BARRIER
986     _BEGIN_MASTER( myThid )
987    
988     C-- Set suffix for this set of data files.
989     suff = checkPtSuff(nCheckLev)
990     IF ( permCheckPoint ) THEN
991     WRITE(suff,'(I10.10)') myIter
992     ENDIF
993    
994     C-- Set IO "context" for writing state
995     CALL DFILE_SET_RW
996     CALL DFILE_SET_CONT_ON_ERROR
997     C Force 64-bit IO
998     writeBinaryPrec = precFloat64
999    
1000    
1001     C-- Read IO error counter
1002     beginIOErrCount = IO_ERRCOUNT(myThid)
1003    
1004     C-- Write model fields
1005     C Raw fields
1006     CALL WRITE_FLD_XYZ_RL( 'uVel.',suff, uVel, myIter, myThid)
1007     CALL WRITE_FLD_XYZ_RL( 'gU.',suff, gU, myIter, myThid)
1008     CALL WRITE_FLD_XYZ_RL( 'gUNm1.',suff, gUNm1, myIter, myThid)
1009     CALL WRITE_FLD_XYZ_RL( 'vVel.',suff, vVel, myIter, myThid)
1010     CALL WRITE_FLD_XYZ_RL( 'gV.',suff, gV, myIter, myThid)
1011     CALL WRITE_FLD_XYZ_RL( 'gVNm1.',suff, gVNm1, myIter, myThid)
1012     CALL WRITE_FLD_XYZ_RL( 'theta.',suff, theta, myIter, myThid)
1013     CALL WRITE_FLD_XYZ_RL( 'gT.',suff, gT, myIter, myThid)
1014     CALL WRITE_FLD_XYZ_RL( 'gTNm1.',suff, gTNm1, myIter, myThid)
1015     CALL WRITE_FLD_XYZ_RL( 'salt.',suff, salt, myIter, myThid)
1016     CALL WRITE_FLD_XYZ_RL( 'gS.',suff, gS, myIter, myThid)
1017     CALL WRITE_FLD_XYZ_RL( 'gSNm1.',suff, gSNm1, myIter, myThid)
1018     CALL WRITE_FLD_XY_RL ( 'cg2d_x.',suff, cg2d_x, myIter, myThid)
1019 cnh 1.2 #ifdef ALLOW_CD
1020     CALL WRITE_FLD_XY_RL ( 'cg2d_xNM1.',suff, cg2d_xNM1, myIter, myThid)
1021     CALL WRITE_FLD_XYZ_RL( 'uVelD.',suff, uVelD, myIter, myThid)
1022     CALL WRITE_FLD_XYZ_RL( 'vVelD.',suff, vVelD, myIter, myThid)
1023     CALL WRITE_FLD_XYZ_RL( 'uNM1.', suff, uNM1, myIter, myThid)
1024     CALL WRITE_FLD_XYZ_RL( 'vNM1.', suff, vNM1, myIter, myThid)
1025     CALL WRITE_FLD_XYZ_RL( 'guCD.', suff, guCD, myIter, myThid)
1026     CALL WRITE_FLD_XYZ_RL( 'gvCD.', suff, gvCD, myIter, myThid)
1027     #endif
1028    
1029 cnh 1.1
1030     C-- Reread IO error counter
1031     endIOErrCount = IO_ERRCOUNT(myThid)
1032    
1033     C-- Check for IO errors
1034     IF ( endIOErrCount .NE. beginIOErrCount ) THEN
1035     WRITE(msgBuf,'(A)') 'S/R WRITE_CHECKPOINT'
1036     CALL PRINT_ERROR( msgBuf, 1 )
1037     WRITE(msgBuf,'(A)') 'Error writing out model checkpoint'
1038     CALL PRINT_ERROR( msgBuf, 1 )
1039     WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1040     CALL PRINT_ERROR( msgBuf, 1 )
1041     ELSE
1042     WRITE(msgBuf,'(A,I10)') '// Model checkpoint written, timestep', myIter
1043     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1044     WRITE(msgBuf,'(A)') ' '
1045     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1046     C Wrote OK so step forward to use next checkpoint in loop.
1047     IF ( .NOT. permCheckPoint ) THEN
1048     nCheckLev = MOD(nCheckLev, maxNoChkptLev)+1
1049     ENDIF
1050     ENDIF
1051    
1052     _END_MASTER( myThid )
1053     _BARRIER
1054    
1055     ENDIF
1056    
1057     RETURN
1058     END
1059    
1060     CStartofinterface
1061     SUBROUTINE WRITE_STATE ( myCurrentTime, myIter, myThid )
1062     C /==========================================================\
1063     C | SUBROUTINE WRITE_STATE |
1064     C | o Controlling routine for IO to dump model state. |
1065     C |==========================================================|
1066     C | Write model state files for post-processing. This file |
1067     C | includes code for diagnosing W and RHO for output. |
1068     C \==========================================================/
1069    
1070     C == Global variables ===
1071     #include "SIZE.h"
1072     #include "EEPARAMS.h"
1073     #include "PARAMS.h"
1074     #include "DYNVARS.h"
1075     #include "CG2D.h"
1076    
1077     LOGICAL DIFFERENT_MULTIPLE
1078     EXTERNAL DIFFERENT_MULTIPLE
1079     INTEGER IO_ERRCOUNT
1080     EXTERNAL IO_ERRCOUNT
1081    
1082     C == Routine arguments ==
1083     C myThid - Thread number for this instance of the routine.
1084     C myIter - Iteration number
1085     C myCurrentTime - Current time of simulation ( s )
1086     INTEGER myThid
1087     INTEGER myIter
1088     REAL myCurrentTime
1089     CEndofinterface
1090    
1091     C == Local variables ==
1092     C suff - Hold suffix part of a filename
1093     C beginIOErrCount - Begin and end IO error counts
1094     C endIOErrCount
1095     C msgBuf - Error message buffer
1096     CHARACTER*(MAX_LEN_FNAM) suff
1097     INTEGER beginIOErrCount
1098     INTEGER endIOErrCount
1099     CHARACTER*(MAX_LEN_MBUF) msgBuf
1100    
1101     IF ( .NOT.
1102     & DIFFERENT_MULTIPLE(dumpFreq,myCurrentTime,myCurrentTime-deltaTClock)
1103     & ) RETURN
1104    
1105     C-- Going to really do some IO. Make everyone except master thread wait.
1106     _BARRIER
1107     _BEGIN_MASTER( myThid )
1108    
1109     C-- Set suffix for this set of data files.
1110     WRITE(suff,'(I10.10)') myIter
1111    
1112     C-- Set IO "context" for writing state
1113     CALL DFILE_SET_RW
1114     CALL DFILE_SET_CONT_ON_ERROR
1115     writeBinaryPrec = writeStatePrec
1116    
1117     C-- Read IO error counter
1118     beginIOErrCount = IO_ERRCOUNT(myThid)
1119    
1120     C-- Write model fields
1121     C Raw fields
1122     CALL WRITE_FLD_XYZ_RL( 'U.',suff, uVel, myIter, myThid)
1123     CALL WRITE_FLD_XYZ_RL( 'V.',suff, vVel, myIter, myThid)
1124     CALL WRITE_FLD_XYZ_RL( 'T.',suff, theta, myIter, myThid)
1125     CALL WRITE_FLD_XYZ_RL( 'S.',suff, salt, myIter, myThid)
1126     CALL WRITE_FLD_XY_RL ( 'H.',suff, cg2d_x, myIter, myThid)
1127     C Hmmm.... what to do atbout these huh
1128     C need to calculate them but remember we are already within a
1129     C _MASTER section. So we can not use multithreaded code.
1130     C We can still code as blocked but the block loop will be
1131     C bj=1,nSy and bi=1,nSx.
1132     C CALL WRITE_FLD_XYZ_RL( 'W.',suff, arr3d , myIter, myThid)
1133     C CALL WRITE_FLD_XYZ_RL( 'RHO.',suff, arr3d , myIter, myThid)
1134     C CALL WRITE_FLD_XYZ_RL('RHOP.',suff, arr3d , myIter, myThid)
1135     C CALL WRITE_FLD_XYZ_RL( 'PH.',suff, arr3d , myIter, myThid)
1136    
1137     C-- Reread IO error counter
1138     endIOErrCount = IO_ERRCOUNT(myThid)
1139    
1140     C-- Check for IO errors
1141     IF ( endIOErrCount .NE. beginIOErrCount ) THEN
1142     WRITE(msgBuf,'(A)') 'S/R WRITE_STATE'
1143     CALL PRINT_ERROR( msgBuf, 1 )
1144     WRITE(msgBuf,'(A)') 'Error writing out model state'
1145     CALL PRINT_ERROR( msgBuf, 1 )
1146     WRITE(msgBuf,'(A,I10)') 'Timestep ',myIter
1147     CALL PRINT_ERROR( msgBuf, 1 )
1148     ELSE
1149     WRITE(msgBuf,'(A,I10)') '// Model state written, timestep', myIter
1150     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1151     WRITE(msgBuf,'(A)') ' '
1152     CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, SQUEEZE_RIGHT, 1 )
1153     ENDIF
1154    
1155     _END_MASTER( myThid )
1156     _BARRIER
1157    
1158     RETURN
1159     END
  ViewVC Help
Powered by ViewVC 1.1.22