/[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.21 - (show annotations) (download)
Wed Sep 26 18:09:16 2001 UTC (22 years, 8 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint51k_post, checkpoint47e_post, checkpoint57m_post, checkpoint52l_pre, ecco_c44_e19, hrcube4, hrcube5, checkpoint46l_post, checkpoint57g_pre, checkpoint46g_pre, checkpoint47c_post, release1_p13_pre, checkpoint50c_post, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint46f_post, checkpoint52d_pre, checkpoint57g_post, checkpoint48e_post, checkpoint56b_post, checkpoint50g_post, checkpoint57y_post, checkpoint46b_post, checkpoint52j_pre, checkpoint43a-release1mods, checkpoint51o_pre, checkpoint44g_post, checkpoint54d_post, checkpoint48c_post, checkpoint54e_post, ecco_c50_e32, ecco_c50_e33, ecco_c50_e30, ecco_c50_e31, release1_p13, checkpoint51l_post, checkpoint48i_post, checkpoint57r_post, checkpoint46l_pre, checkpoint57d_post, checkpoint57i_post, checkpoint50d_pre, checkpoint52k_post, chkpt44d_post, checkpoint59, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint51, checkpoint53, checkpoint52, release1_p8, release1_p9, checkpoint50d_post, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint58f_post, checkpoint52f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint50b_pre, checkpoint44e_pre, checkpoint57z_post, checkpoint54f_post, checkpoint51f_post, release1_b1, checkpoint48b_post, ecco_c51_e34d, ecco_c51_e34e, ecco_c51_e34f, ecco_c51_e34g, ecco_c51_e34a, ecco_c51_e34b, ecco_c51_e34c, checkpoint58y_post, checkpoint43, checkpoint51d_post, checkpoint48c_pre, checkpoint55a_post, checkpoint51t_post, checkpoint58t_post, checkpoint51n_post, release1_chkpt44d_post, checkpoint55i_post, chkpt44c_pre, checkpoint52i_pre, checkpoint57h_post, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint57t_post, checkpoint55c_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint52e_pre, checkpoint57v_post, release1_p11, checkpoint57f_post, checkpoint52e_post, checkpoint51n_pre, checkpoint47d_post, icebear5, icebear4, icebear3, icebear2, checkpoint53d_post, checkpoint46d_pre, checkpoint57a_post, checkpoint48d_post, release1-branch_tutorials, checkpoint57h_pre, checkpoint57x_post, checkpoint48f_post, checkpoint45d_post, checkpoint52b_pre, checkpoint54b_post, checkpoint46j_pre, checkpoint58w_post, ecco_c50_e28, checkpoint51l_pre, checkpoint52m_post, checkpoint47d_pre, checkpoint57y_pre, checkpoint53b_post, checkpoint55g_post, checkpoint44h_pre, checkpoint48h_post, checkpoint51q_post, ecco_c50_e29, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint52b_post, chkpt44c_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46k_post, checkpoint46b_pre, checkpoint57l_post, checkpoint58o_post, checkpoint52h_pre, checkpoint45a_post, checkpoint57c_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, hrcube_1, checkpoint58p_post, checkpoint58q_post, checkpoint51m_post, checkpoint52c_post, checkpoint44e_post, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, release1_p12, checkpoint58e_post, release1_p10, mitgcm_mapl_00, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint58m_post, checkpoint47a_post, ecco_c50_e33a, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, branchpoint-genmake2, checkpoint54a_post, checkpoint46e_pre, checkpoint55h_post, checkpoint58n_post, checkpoint51r_post, checkpoint45b_post, checkpoint51i_post, checkpoint57e_post, release1-branch-end, release1_final_v1, checkpoint55b_post, checkpoint51b_post, release1_p12_pre, checkpoint46c_pre, checkpoint53a_post, checkpoint44f_post, checkpoint47b_post, checkpoint44b_post, checkpoint59a, checkpoint55f_post, ecco_c51_e34, checkpoint46h_pre, checkpoint52d_post, checkpoint53g_post, checkpoint46m_post, checkpoint57p_post, checkpint57u_post, checkpoint46a_pre, checkpoint50c_pre, checkpoint45c_post, checkpoint57q_post, ecco_ice2, ecco_ice1, checkpoint44h_post, eckpoint57e_pre, checkpoint46g_post, checkpoint51c_post, checkpoint58k_post, checkpoint52a_pre, checkpoint46i_post, checkpoint58v_post, checkpoint50h_post, checkpoint52i_post, checkpoint50e_pre, checkpoint50i_post, ecco_c44_e25, checkpoint54c_post, checkpoint51i_pre, checkpoint48a_post, checkpoint56a_post, checkpoint58l_post, checkpoint53f_post, checkpoint47j_post, checkpoint54a_pre, checkpoint53b_pre, branch-exfmods-tag, checkpoint57h_done, checkpoint52j_post, checkpoint47f_post, checkpoint50e_post, chkpt44a_pre, ecco_c44_e22, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco_c44_e26, ecco_c44_e27, ecco_c44_e24, checkpoint57j_post, checkpoint57f_pre, checkpoint46c_post, checkpoint58g_post, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, branch-netcdf, checkpoint52l_post, checkpoint58x_post, checkpoint52n_post, checkpoint46e_post, release1_beta1, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint51e_post, checkpoint44b_pre, checkpoint42, checkpoint57a_pre, checkpoint41, checkpoint46, checkpoint47, checkpoint44, checkpoint45, checkpoint48, checkpoint49, checkpoint57o_post, checkpoint46h_post, checkpoint51o_post, checkpoint50, checkpoint57k_post, checkpoint51f_pre, chkpt44a_post, checkpoint47h_post, checkpoint52a_post, checkpoint57w_post, checkpoint44f_pre, checkpoint58i_post, checkpoint51g_post, ecco_c52_e35, checkpoint46d_post, checkpoint50b_post, checkpoint58c_post, checkpoint58u_post, release1-branch_branchpoint, checkpoint52f_pre, checkpoint53d_pre, checkpoint58s_post, checkpoint55e_post, checkpoint51a_post, checkpoint51p_post, checkpoint48g_post, checkpoint51u_post, checkpoint55d_post
Branch point for: c24_e25_ice, branch-exfmods-curt, release1_coupled, release1_final, release1-branch, branch-genmake2, release1, branch-nonh, tg2-branch, ecco-branch, release1_50yr, netcdf-sm0, icebear, checkpoint51n_branch
Changes since 1.20: +166 -102 lines
Bringing comments up to data and formatting for document extraction.

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

  ViewVC Help
Powered by ViewVC 1.1.22