1 |
C $Header: /u/gcmpack/models/MITgcmUV/model/src/read_write.F,v 1.20 2001/02/04 16:46:44 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 readilya 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_1D_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 readilya 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 |
C !ROUTINE: WRITE_XY_XLINE_RS |
342 |
C !INTERFACE: |
343 |
SUBROUTINE WRITE_XY_XLINE_RS( |
344 |
I fld, sCoord, tCoord, |
345 |
I head, comment ) |
346 |
|
347 |
C !DESCRIPTION: \bv |
348 |
C *==========================================================* |
349 |
C | o SUBROUTINE WRITE_XY_XLINE_RS |
350 |
C | Prints out X row of an XY RS field e.g. phi(:,n,:,m) |
351 |
C *==========================================================* |
352 |
C | This routine produces a standard format for list |
353 |
C | one-dimensional RS data in textual form. The format |
354 |
C | is designed to be readily parsed by a post-processing |
355 |
C | utility. |
356 |
C *==========================================================* |
357 |
C \ev |
358 |
|
359 |
C !USES: |
360 |
IMPLICIT NONE |
361 |
C == Global data == |
362 |
#include "SIZE.h" |
363 |
#include "EEPARAMS.h" |
364 |
EXTERNAL IFNBLNK |
365 |
INTEGER IFNBLNK |
366 |
EXTERNAL ILNBLNK |
367 |
INTEGER ILNBLNK |
368 |
|
369 |
C !INPUT/OUTPUT PARAMETERS: |
370 |
C == Routine arguments == |
371 |
C fld - Field to be printed |
372 |
C sCoord - subgrid coordinate |
373 |
C tCoord - tile coordinate |
374 |
C head - Statement start e.g. phi = |
375 |
C comment - Descriptive comment for field |
376 |
_RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
377 |
INTEGER sCoord |
378 |
INTEGER tCoord |
379 |
CHARACTER*(*) head |
380 |
CHARACTER*(*) comment |
381 |
|
382 |
C !LOCAL VARIABLES: |
383 |
C == Local variables == |
384 |
CHARACTER*(MAX_LEN_MBUF) msgBuf1 |
385 |
CHARACTER*(MAX_LEN_MBUF) msgBuf2 |
386 |
CHARACTER*10 num1, num2 |
387 |
REAL*8 xcoord(sNx*nSx) |
388 |
INTEGER bi, bj, i, j |
389 |
INTEGER IFN1, ILN1, IFN2, ILN2 |
390 |
CEOP |
391 |
|
392 |
WRITE(msgBuf1,'(A,A)') head,' = ' |
393 |
bj = tCoord |
394 |
J = sCoord |
395 |
WRITE(num1,'(I10)') J |
396 |
WRITE(num2,'(I10)') bj |
397 |
IFN1 = IFNBLNK(num1) |
398 |
ILN1 = ILNBLNK(num1) |
399 |
IFN2 = IFNBLNK(num2) |
400 |
ILN2 = ILNBLNK(num2) |
401 |
C fld(:,J,:,bj) |
402 |
WRITE(msgBuf2,'(A,A,A,A,A,A,A,A,A)') |
403 |
& ' /* ', head,'(:,', |
404 |
& num1(IFN1:ILN1),',:,', |
405 |
& num2(IFN2:ILN2),') ', |
406 |
& comment,' */' |
407 |
DO bi=1,nSx |
408 |
DO I=1,sNx |
409 |
xcoord(sNx*(bi-1)+I)=fld(I,J,bi,bj) |
410 |
ENDDO |
411 |
ENDDO |
412 |
CALL WRITE_1D_R8( xcoord, sNx*nSx, INDEX_I,msgBuf1,msgBuf2) |
413 |
|
414 |
RETURN |
415 |
END |
416 |
|
417 |
CBOP |
418 |
C !ROUTINE: WRITE_XY_YLINE_RS |
419 |
C !INTERFACE: |
420 |
SUBROUTINE WRITE_XY_YLINE_RS( |
421 |
I fld, sCoord, tCoord, |
422 |
I head, comment ) |
423 |
|
424 |
C !DESCRIPTION: \bv |
425 |
C *==========================================================* |
426 |
C | o SUBROUTINE WRITE_XY_YLINE_RS |
427 |
C | Prints out Y row of an XY RS field e.g. phi(n,:,m,:) |
428 |
C *==========================================================* |
429 |
C | This routine produces a standard format for list |
430 |
C | one-dimensional RS data in textual form. The format |
431 |
C | is designed to be readily parsed by a post-processing |
432 |
C | utility. |
433 |
C *==========================================================* |
434 |
C \ev |
435 |
|
436 |
C !USES: |
437 |
IMPLICIT NONE |
438 |
C == Global data == |
439 |
#include "SIZE.h" |
440 |
#include "EEPARAMS.h" |
441 |
EXTERNAL IFNBLNK |
442 |
INTEGER IFNBLNK |
443 |
EXTERNAL ILNBLNK |
444 |
INTEGER ILNBLNK |
445 |
|
446 |
C !INPUT/OUTPUT PARAMETERS: |
447 |
C == Routine arguments == |
448 |
C fld - Field to be printed |
449 |
C sCoord - subgrid coordinate |
450 |
C tCoord - tile coordinate |
451 |
C head - Statement start e.g. phi = |
452 |
C comment - Descriptive comment for field |
453 |
_RS fld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy) |
454 |
INTEGER sCoord |
455 |
INTEGER tCoord |
456 |
CHARACTER*(*) head |
457 |
CHARACTER*(*) comment |
458 |
|
459 |
C !LOCAL VARIABLES: |
460 |
C == Local variables == |
461 |
CHARACTER*(MAX_LEN_MBUF) msgBuf1 |
462 |
CHARACTER*(MAX_LEN_MBUF) msgBuf2 |
463 |
REAL*8 ycoord(sNy*nSy) |
464 |
INTEGER bi, bj, i, j |
465 |
CHARACTER*10 num1, num2 |
466 |
INTEGER IFN1, ILN1, IFN2, ILN2 |
467 |
CEOP |
468 |
|
469 |
WRITE(msgBuf1,'(A,A)') head,' = ' |
470 |
bi = tCoord |
471 |
I = sCoord |
472 |
WRITE(num1,'(I10)') I |
473 |
WRITE(num2,'(I10)') bi |
474 |
IFN1 = IFNBLNK(num1) |
475 |
ILN1 = ILNBLNK(num1) |
476 |
IFN2 = IFNBLNK(num2) |
477 |
ILN2 = ILNBLNK(num2) |
478 |
C fld(I,:,bi,:) |
479 |
WRITE(msgBuf2,'(A,A,A,A,A,A,A,A,A)') |
480 |
& ' /* ',head,'(', |
481 |
& num1(IFN1:ILN1),',:,', |
482 |
& num2(IFN2:ILN2),',:) ', |
483 |
& comment,' */' |
484 |
DO bj=1,nSy |
485 |
DO J=1,sNy |
486 |
ycoord(sNy*(bj-1)+J)=fld(I,J,bi,bj) |
487 |
ENDDO |
488 |
ENDDO |
489 |
CALL WRITE_1D_R8( ycoord, sNy*nSy, INDEX_J,msgBuf1,msgBuf2) |
490 |
|
491 |
RETURN |
492 |
END |