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

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

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


Revision 1.22 - (show annotations) (download)
Mon May 7 23:13:57 2007 UTC (17 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint61f, checkpoint59j, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61l, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i
Changes since 1.21: +83 -4 lines
add S/R WRITE_0D_C to print character string.

1 C $Header: /u/gcmpack/MITgcm/model/src/read_write.F,v 1.21 2001/09/26 18:09:16 cnh Exp $
2 C $Name: $
3 #include "CPP_OPTIONS.h"
4
5 CStartofinterface
6 CBOP
7 C !ROUTINE: WRITE_1D_I
8 C !INTERFACE:
9 SUBROUTINE WRITE_1D_I( fld, lFld, index_type, head, comment )
10
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | o SUBROUTINE WRITE_1D_I
14 C | Controls formatted, tabular I/O for a one-dimensional
15 C | INTEGER field.
16 C *==========================================================*
17 C | This routine produces a standard format for list
18 C | one-dimensional INTEGER data in textual form. The format
19 C | is designed to be readily parsed by a post-processing
20 C | utility.
21 C *==========================================================*
22 C \ev
23
24 C !USES:
25 IMPLICIT NONE
26 C == Global data ==
27 #include "SIZE.h"
28 #include "EEPARAMS.h"
29
30 C !INPUT/OUTPUT PARAMETERS:
31 C == Routine arguments ==
32 C fld - Field to be printed
33 C lFld - Number of elements in field fld.
34 C index_type - Type of index labelling (I=,J=,...) to use
35 C head - Statement start e.g. phi =
36 C comment - Descriptive comment for field
37 INTEGER lFld
38 INTEGER fld(lFld)
39 INTEGER index_type
40 CHARACTER*(*) head
41 CHARACTER*(*) comment
42
43 C !LOCAL VARIABLES:
44 C == Local variables ==
45 CHARACTER*(MAX_LEN_MBUF) msgBuf
46 CEOP
47
48 WRITE(msgBuf,'(A,A)') head, comment
49 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
50 & SQUEEZE_RIGHT , 1)
51 CALL PRINT_LIST_I( fld, lFld, index_type, .FALSE.,
52 & .TRUE., standardMessageUnit )
53 WRITE(msgBuf,'(A)') ' ; '
54 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
55 & SQUEEZE_RIGHT , 1)
56
57 END
58
59
60 CBOP
61 C !ROUTINE: WRITE_1D_L
62 C !INTERFACE:
63 SUBROUTINE WRITE_1D_L( fld, lFld, index_type, head, comment )
64
65 C !DESCRIPTION: \bv
66 C *==========================================================*
67 C | o SUBROUTINE WRITE_1D_L
68 C | Controls formatted, tabular I/O for a one-dimensional
69 C | LOGICAL field.
70 C *==========================================================*
71 C | This routine produces a standard format for list
72 C | one-dimensional LOGICAL data in textual form. The format
73 C | is designed to be readily parsed by a post-processing
74 C | utility.
75 C *==========================================================*
76 C \ev
77
78 C !USES:
79 IMPLICIT NONE
80 C == Global data ==
81 #include "SIZE.h"
82 #include "EEPARAMS.h"
83
84 C !INPUT/OUTPUT PARAMETERS:
85 C == Routine arguments ==
86 C fld - Field to be printed
87 C lFld - Number of elements in field fld.
88 C index_type - Type of index labelling (I=,J=,...) to use
89 C head - Statement start e.g. phi =
90 C comment - Descriptive comment for field
91 INTEGER lFld
92 LOGICAL fld(lFld)
93 INTEGER index_type
94 CHARACTER*(*) head
95 CHARACTER*(*) comment
96
97 C !LOCAL VARIABLES:
98 C == Local variables ==
99 CHARACTER*(MAX_LEN_MBUF) msgBuf
100 CEOP
101
102 WRITE(msgBuf,'(A,A)') head, comment
103 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
104 & SQUEEZE_RIGHT , 1)
105 CALL PRINT_LIST_L( fld, lFld, index_type, .FALSE.,
106 & .TRUE., standardMessageUnit )
107 WRITE(msgBuf,'(A)') ' ; '
108 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
109 & SQUEEZE_RIGHT , 1)
110
111 END
112
113
114 CBOP
115 C !ROUTINE: WRITE_1D_R8
116 C !INTERFACE:
117 SUBROUTINE WRITE_1D_R8( fld, lFld, index_type, head, comment )
118
119 C !DESCRIPTION: \bv
120 C *==========================================================*
121 C | o SUBROUTINE WRITE_1D_R8
122 C | Controls formatted, tabular I/O for a one-dimensional
123 C | real*8 field.
124 C *==========================================================*
125 C | This routine produces a standard format for list
126 C | one-dimensional real*8 data in textual form. The format
127 C | is designed to be readily parsed by a post-processing
128 C | utility.
129 C *==========================================================*
130 C \ev
131
132 C !USES:
133 IMPLICIT NONE
134 C == Global data ==
135 #include "SIZE.h"
136 #include "EEPARAMS.h"
137 EXTERNAL ILNBLNK
138 INTEGER ILNBLNK
139
140 C !INPUT/OUTPUT PARAMETERS:
141 C == Routine arguments ==
142 C fld - Field to be printed
143 C lFld - Number of elements in field fld.
144 C index_type - Type of index labelling (I=,J=,...) to use
145 C head - Statement start e.g. phi =
146 C comment - Descriptive comment for field
147 INTEGER lFld
148 Real*8 fld(lFld)
149 INTEGER index_type
150 CHARACTER*(*) head
151 CHARACTER*(*) comment
152
153 C !LOCAL VARIABLES:
154 C == Local variables ==
155 C ILH, ILC - Index of last balnk in head and comment
156 CHARACTER*(MAX_LEN_MBUF) msgBuf
157 INTEGER ILH, ILC
158 CEOP
159
160 ILH=ILNBLNK(head)
161 ILC=ILNBLNK(comment)
162 WRITE(msgBuf,'(A,A)') head(1:ILH), comment(1:ILC)
163 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
164 & SQUEEZE_RIGHT , 1)
165 CALL PRINT_LIST_R8( fld, lFld, index_type, .FALSE.,
166 & .TRUE., standardMessageUnit )
167 WRITE(msgBuf,'(A)') ' ; '
168 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
169 & SQUEEZE_RIGHT , 1)
170
171 END
172
173
174 CBOP
175 C !ROUTINE: WRITE_0D_I
176 C !INTERFACE:
177 SUBROUTINE WRITE_0D_I( fld, index_type, head, comment )
178
179 C !DESCRIPTION: \bv
180 C *==========================================================*
181 C | o SUBROUTINE WRITE_1D_I
182 C | Controls formatted, tabular I/O for a one-dimensional
183 C | INTEGER field.
184 C *==========================================================*
185 C | This routine produces a standard format for list
186 C | one-dimensional INTEGER data in textual form. The format
187 C | is designed to be readily parsed by a post-processing
188 C | utility.
189 C *==========================================================*
190 C \ev
191
192 C !USES:
193 IMPLICIT NONE
194 C == Global data ==
195 #include "SIZE.h"
196 #include "EEPARAMS.h"
197
198 C !INPUT/OUTPUT PARAMETERS:
199 C == Routine arguments ==
200 C fld - Field to be printed
201 C lFld - Number of elements in field fld.
202 C index_type - Type of index labelling (I=,J=,...) to use
203 C head - Statement start e.g. phi =
204 C comment - Descriptive comment for field
205 INTEGER fld
206 INTEGER index_type
207 CHARACTER*(*) head
208 CHARACTER*(*) comment
209
210 C !LOCAL VARIABLES:
211 C == Local variables ==
212 CHARACTER*(MAX_LEN_MBUF) msgBuf
213 INTEGER idummy(1)
214 CEOP
215
216 idummy(1) = fld
217
218 WRITE(msgBuf,'(A,A)') head, comment
219 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
220 & SQUEEZE_RIGHT , 1)
221 CALL PRINT_LIST_I( idummy, 1, index_type, .FALSE.,
222 & .TRUE., standardMessageUnit )
223 WRITE(msgBuf,'(A)') ' ; '
224 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
225 & SQUEEZE_RIGHT , 1)
226
227 END
228
229
230 CBOP
231 C !ROUTINE: WRITE_0D_L
232 C !INTERFACE:
233 SUBROUTINE WRITE_0D_L( fld, index_type, head, comment )
234
235 C !DESCRIPTION: \bv
236 C *==========================================================*
237 C | o SUBROUTINE WRITE_1D_L
238 C | Controls formatted, tabular I/O for a one-dimensional
239 C | LOGICAL field.
240 C *==========================================================*
241 C | This routine produces a standard format for list
242 C | one-dimensional LOGICAL data in textual form. The format
243 C | is designed to be readily parsed by a post-processing
244 C | utility.
245 C *==========================================================*
246 C \ev
247
248 C !USES:
249 IMPLICIT NONE
250 C == Global data ==
251 #include "SIZE.h"
252 #include "EEPARAMS.h"
253
254 C !INPUT/OUTPUT PARAMETERS:
255 C == Routine arguments ==
256 C fld - Field to be printed
257 C lFld - Number of elements in field fld.
258 C index_type - Type of index labelling (I=,J=,...) to use
259 C head - Statement start e.g. phi =
260 C comment - Descriptive comment for field
261 LOGICAL fld
262 INTEGER index_type
263 CHARACTER*(*) head
264 CHARACTER*(*) comment
265
266 C !LOCAL VARIABLES:
267 C == Local variables ==
268 CHARACTER*(MAX_LEN_MBUF) msgBuf
269 LOGICAL ldummy(1)
270 CEOP
271
272 ldummy(1) = fld
273 WRITE(msgBuf,'(A,A)') head, comment
274 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
275 & SQUEEZE_RIGHT , 1)
276 CALL PRINT_LIST_L( ldummy, 1, index_type, .FALSE.,
277 & .TRUE., standardMessageUnit )
278 WRITE(msgBuf,'(A)') ' ; '
279 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
280 & SQUEEZE_RIGHT , 1)
281
282 END
283
284
285 CBOP
286 C !ROUTINE: WRITE_0D_R8
287 C !INTERFACE:
288 SUBROUTINE WRITE_0D_R8( fld, index_type, head, comment )
289
290 C !DESCRIPTION: \bv
291 C *==========================================================*
292 C | o SUBROUTINE WRITE_0D_R8
293 C | Controls formatted, tabular I/O for a one-dimensional
294 C | real*8 field.
295 C *==========================================================*
296 C | This routine produces a standard format for list
297 C | one-dimensional real*8 data in textual form. The format
298 C | is designed to be readily parsed by a post-processing
299 C | utility.
300 C *==========================================================*
301 C \ev
302
303 C !USES:
304 IMPLICIT NONE
305 C == Global data ==
306 #include "SIZE.h"
307 #include "EEPARAMS.h"
308
309 C !INPUT/OUTPUT PARAMETERS:
310 C == Routine arguments ==
311 C fld - Field to be printed
312 C lFld - Number of elements in field fld.
313 C index_type - Type of index labelling (I=,J=,...) to use
314 C head - Statement start e.g. phi =
315 C comment - Descriptive comment for field
316 Real*8 fld
317 INTEGER index_type
318 CHARACTER*(*) head
319 CHARACTER*(*) comment
320
321 C !LOCAL VARIABLES:
322 C == Local variables ==
323 CHARACTER*(MAX_LEN_MBUF) msgBuf
324 Real*8 r8dummy(1)
325 CEOP
326
327 r8dummy(1) = fld
328
329 WRITE(msgBuf,'(A,A)') head, comment
330 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
331 & SQUEEZE_RIGHT , 1)
332 CALL PRINT_LIST_R8( r8dummy, 1, index_type, .FALSE.,
333 & .TRUE., standardMessageUnit )
334 WRITE(msgBuf,'(A)') ' ; '
335 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
336 & SQUEEZE_RIGHT , 1)
337
338 END
339
340
341 CBOP
342 C !ROUTINE: WRITE_0D_C
343 C !INTERFACE:
344 SUBROUTINE WRITE_0D_C( fld, lFld, index_type, head, comment )
345
346 C !DESCRIPTION: \bv
347 C *==========================================================*
348 C | o SUBROUTINE WRITE_0D_C
349 C | Controls formatted, tabular I/O for a character string
350 C *==========================================================*
351 C | This routine produces a standard format for list
352 C | a character string data in textual form. The format
353 C | is designed to be readily parsed by a post-processing
354 C | utility.
355 C *==========================================================*
356 C \ev
357
358 C !USES:
359 IMPLICIT NONE
360 C == Global data ==
361 #include "SIZE.h"
362 #include "EEPARAMS.h"
363
364 C !INPUT/OUTPUT PARAMETERS:
365 C == Routine arguments ==
366 C fld :: Field to be printed
367 C lFld :: Number of character (in field fld.) to print
368 C 0 = all ; -1 & -2 = until the last non-blank
369 C -2 = starting at the first non-blank
370 C index_type :: Type of index labelling (I=,J=,...) to use
371 C head :: Statement start e.g. phi =
372 C comment :: Descriptive comment for field
373 CHARACTER*(*) fld
374 INTEGER lFld
375 INTEGER index_type
376 CHARACTER*(*) head
377 CHARACTER*(*) comment
378
379 C !FUNCTIONS:
380 INTEGER IFNBLNK
381 INTEGER ILNBLNK
382 EXTERNAL IFNBLNK
383 EXTERNAL ILNBLNK
384
385 C !LOCAL VARIABLES:
386 C == Local variables ==
387 CHARACTER*(MAX_LEN_MBUF) msgBuf
388 INTEGER iS,iL
389 CEOP
390
391 iS = 1
392 iL = LEN(fld)
393 IF ( lFld .GT. 0 ) THEN
394 iL = MIN( lFld, iL )
395 ELSEIF ( lFld .LT. 0 ) THEN
396 iL = ILNBLNK(fld)
397 ENDIF
398 IF ( lFld .EQ. -2 ) iS = IFNBLNK(fld)
399 iS = MAX(1,iS)
400
401 WRITE(msgBuf,'(A,A)') head, comment
402 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
403 & SQUEEZE_RIGHT, 1 )
404 IF ( iL.GE.iS ) THEN
405 iL = MIN( MAX_LEN_MBUF + iS - 17, iL )
406 WRITE(msgBuf,'(14X,3A)') "'", fld(iS:iL), "'"
407 ELSE
408 WRITE(msgBuf,'(14X,3A)') "'","'"
409 ENDIF
410 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
411 & SQUEEZE_RIGHT, 1 )
412 WRITE(msgBuf,'(A)') ' ;'
413 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
414 & SQUEEZE_RIGHT, 1 )
415
416 RETURN
417 END
418
419
420 C !ROUTINE: WRITE_XY_XLINE_RS
421 C !INTERFACE:
422 SUBROUTINE WRITE_XY_XLINE_RS(
423 I fld, sCoord, tCoord,
424 I head, comment )
425
426 C !DESCRIPTION: \bv
427 C *==========================================================*
428 C | o SUBROUTINE WRITE_XY_XLINE_RS
429 C | Prints out X row of an XY RS field e.g. phi(:,n,:,m)
430 C *==========================================================*
431 C | This routine produces a standard format for list
432 C | one-dimensional RS data in textual form. The format
433 C | is designed to be readily parsed by a post-processing
434 C | utility.
435 C *==========================================================*
436 C \ev
437
438 C !USES:
439 IMPLICIT NONE
440 C == Global data ==
441 #include "SIZE.h"
442 #include "EEPARAMS.h"
443 EXTERNAL IFNBLNK
444 INTEGER IFNBLNK
445 EXTERNAL ILNBLNK
446 INTEGER ILNBLNK
447
448 C !INPUT/OUTPUT PARAMETERS:
449 C == Routine arguments ==
450 C fld - Field to be printed
451 C sCoord - subgrid coordinate
452 C tCoord - tile coordinate
453 C head - Statement start e.g. phi =
454 C comment - Descriptive comment for field
455 _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
456 INTEGER sCoord
457 INTEGER tCoord
458 CHARACTER*(*) head
459 CHARACTER*(*) comment
460
461 C !LOCAL VARIABLES:
462 C == Local variables ==
463 CHARACTER*(MAX_LEN_MBUF) msgBuf1
464 CHARACTER*(MAX_LEN_MBUF) msgBuf2
465 CHARACTER*10 num1, num2
466 REAL*8 xcoord(sNx*nSx)
467 INTEGER bi, bj, i, j
468 INTEGER IFN1, ILN1, IFN2, ILN2
469 CEOP
470
471 WRITE(msgBuf1,'(A,A)') head,' = '
472 bj = tCoord
473 J = sCoord
474 WRITE(num1,'(I10)') J
475 WRITE(num2,'(I10)') bj
476 IFN1 = IFNBLNK(num1)
477 ILN1 = ILNBLNK(num1)
478 IFN2 = IFNBLNK(num2)
479 ILN2 = ILNBLNK(num2)
480 C fld(:,J,:,bj)
481 WRITE(msgBuf2,'(A,A,A,A,A,A,A,A,A)')
482 & ' /* ', head,'(:,',
483 & num1(IFN1:ILN1),',:,',
484 & num2(IFN2:ILN2),') ',
485 & comment,' */'
486 DO bi=1,nSx
487 DO I=1,sNx
488 xcoord(sNx*(bi-1)+I)=fld(I,J,bi,bj)
489 ENDDO
490 ENDDO
491 CALL WRITE_1D_R8( xcoord, sNx*nSx, INDEX_I,msgBuf1,msgBuf2)
492
493 RETURN
494 END
495
496 CBOP
497 C !ROUTINE: WRITE_XY_YLINE_RS
498 C !INTERFACE:
499 SUBROUTINE WRITE_XY_YLINE_RS(
500 I fld, sCoord, tCoord,
501 I head, comment )
502
503 C !DESCRIPTION: \bv
504 C *==========================================================*
505 C | o SUBROUTINE WRITE_XY_YLINE_RS
506 C | Prints out Y row of an XY RS field e.g. phi(n,:,m,:)
507 C *==========================================================*
508 C | This routine produces a standard format for list
509 C | one-dimensional RS data in textual form. The format
510 C | is designed to be readily parsed by a post-processing
511 C | utility.
512 C *==========================================================*
513 C \ev
514
515 C !USES:
516 IMPLICIT NONE
517 C == Global data ==
518 #include "SIZE.h"
519 #include "EEPARAMS.h"
520 EXTERNAL IFNBLNK
521 INTEGER IFNBLNK
522 EXTERNAL ILNBLNK
523 INTEGER ILNBLNK
524
525 C !INPUT/OUTPUT PARAMETERS:
526 C == Routine arguments ==
527 C fld - Field to be printed
528 C sCoord - subgrid coordinate
529 C tCoord - tile coordinate
530 C head - Statement start e.g. phi =
531 C comment - Descriptive comment for field
532 _RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
533 INTEGER sCoord
534 INTEGER tCoord
535 CHARACTER*(*) head
536 CHARACTER*(*) comment
537
538 C !LOCAL VARIABLES:
539 C == Local variables ==
540 CHARACTER*(MAX_LEN_MBUF) msgBuf1
541 CHARACTER*(MAX_LEN_MBUF) msgBuf2
542 REAL*8 ycoord(sNy*nSy)
543 INTEGER bi, bj, i, j
544 CHARACTER*10 num1, num2
545 INTEGER IFN1, ILN1, IFN2, ILN2
546 CEOP
547
548 WRITE(msgBuf1,'(A,A)') head,' = '
549 bi = tCoord
550 I = sCoord
551 WRITE(num1,'(I10)') I
552 WRITE(num2,'(I10)') bi
553 IFN1 = IFNBLNK(num1)
554 ILN1 = ILNBLNK(num1)
555 IFN2 = IFNBLNK(num2)
556 ILN2 = ILNBLNK(num2)
557 C fld(I,:,bi,:)
558 WRITE(msgBuf2,'(A,A,A,A,A,A,A,A,A)')
559 & ' /* ',head,'(',
560 & num1(IFN1:ILN1),',:,',
561 & num2(IFN2:ILN2),',:) ',
562 & comment,' */'
563 DO bj=1,nSy
564 DO J=1,sNy
565 ycoord(sNy*(bj-1)+J)=fld(I,J,bi,bj)
566 ENDDO
567 ENDDO
568 CALL WRITE_1D_R8( ycoord, sNy*nSy, INDEX_J,msgBuf1,msgBuf2)
569
570 RETURN
571 END

  ViewVC Help
Powered by ViewVC 1.1.22