1 |
C $Header: /u/gcmpack/MITgcm/pkg/fizhi/fizhi_readwrite_vegtiles.F,v 1.9 2004/09/29 02:58:51 molod Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "FIZHI_OPTIONS.h" |
5 |
CBOP |
6 |
C !ROUTINE: FIZHI_WRITE_VEGTILES |
7 |
C !INTERFACE: |
8 |
SUBROUTINE FIZHI_WRITE_VEGTILES(fn,pickupflg,myTime,myIter,myThid) |
9 |
|
10 |
C !DESCRIPTION: |
11 |
|
12 |
C !USES: |
13 |
IMPLICIT NONE |
14 |
#include "SIZE.h" |
15 |
#include "fizhi_SIZE.h" |
16 |
#include "fizhi_land_SIZE.h" |
17 |
#include "fizhi_coms.h" |
18 |
#include "fizhi_land_coms.h" |
19 |
#include "fizhi_earth_coms.h" |
20 |
#include "EEPARAMS.h" |
21 |
#ifdef ALLOW_MNC |
22 |
#include "MNC_PARAMS.h" |
23 |
#endif |
24 |
#ifdef ALLOW_EXCH2 |
25 |
#include "W2_EXCH2_TOPOLOGY.h" |
26 |
#include "W2_EXCH2_PARAMS.h" |
27 |
#endif /* ALLOW_EXCH2 */ |
28 |
|
29 |
EXTERNAL ILNBLNK |
30 |
INTEGER ILNBLNK |
31 |
INTEGER MDS_RECLEN |
32 |
|
33 |
C !INPUT/OUTPUT PARAMETERS: |
34 |
CHARACTER*(MAX_LEN_FNAM) fn |
35 |
INTEGER pickupflg |
36 |
_RL myTime |
37 |
INTEGER myIter |
38 |
INTEGER myThid |
39 |
|
40 |
CEOP |
41 |
C !LOCAL VARIABLES: |
42 |
CHARACTER*1 prec |
43 |
CHARACTER*80 bnam |
44 |
character*(80) dataFName |
45 |
integer ilst |
46 |
integer i,k,n |
47 |
integer ig,jg,tn,iunit |
48 |
integer length_of_rec |
49 |
integer bi,bj,irec,fileprec |
50 |
Real*8 r8seg(nchp) |
51 |
|
52 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
53 |
|
54 |
DO i = 1,80 |
55 |
bnam(i:i) = ' ' |
56 |
ENDDO |
57 |
ilst = ILNBLNK(fn) |
58 |
if (pickupflg.eq.0) then |
59 |
prec = 'D' |
60 |
fileprec = 64 |
61 |
WRITE(bnam,'(a,a)') 'pickup_vegtiles.', fn(1:ilst) |
62 |
else |
63 |
prec = 'D' |
64 |
fileprec = 64 |
65 |
WRITE(bnam,'(a,a)') 'state_vegtiles.', fn(1:ilst) |
66 |
endif |
67 |
|
68 |
#ifdef ALLOW_MNC |
69 |
IF (useMNC) THEN |
70 |
|
71 |
C Write fizhi veg-space variables using the MNC package |
72 |
CALL MNC_CW_SET_UDIM(bnam, 1, myThid) |
73 |
CALL MNC_CW_I_W('I',bnam,0,0,'iter', myIter, myThid) |
74 |
|
75 |
C fizhi_coms.h |
76 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'ctmt', ctmt, myThid) |
77 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'xxmt', xxmt, myThid) |
78 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'yymt', yymt, myThid) |
79 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'zetamt', zetamt, myThid) |
80 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'xlmt', xlmt, myThid) |
81 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'khmt', khmt, myThid) |
82 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'tke', tke, myThid) |
83 |
|
84 |
C fizhi_land_coms.h |
85 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'tcanopy', tcanopy, myThid) |
86 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'tdeep', tdeep, myThid) |
87 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'ecanopy', ecanopy, myThid) |
88 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'swetshal', swetshal, myThid) |
89 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'swetroot', swetroot, myThid) |
90 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'swetdeep', swetdeep, myThid) |
91 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'snodep', snodep, myThid) |
92 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'capac', capac, myThid) |
93 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'chlt', chlt, myThid) |
94 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'chlon', chlon, myThid) |
95 |
CALL MNC_CW_I_W('I',bnam,0,0,'igrd', igrd, myThid) |
96 |
|
97 |
C fizhi_earth_coms.h |
98 |
CALL MNC_CW_I_W('I',bnam,0,0,'ityp', ityp, myThid) |
99 |
CALL MNC_CW_RL_W(prec,bnam,0,0,'chfr', chfr, myThid) |
100 |
|
101 |
ENDIF |
102 |
#else /* Next Peice for not ALLOW_MNC */ |
103 |
|
104 |
call MDSFINDUNIT( iunit, mythid ) |
105 |
length_of_rec=MDS_RECLEN( fileprec, nchp, mythid ) |
106 |
|
107 |
DO bj = myByLo(myThid), myByHi(myThid) |
108 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
109 |
|
110 |
#ifdef ALLOW_EXCH2 |
111 |
tn = W2_myTileList(bi) |
112 |
#else |
113 |
iG = bi+(myXGlobalLo-1)/sNx |
114 |
jG = bj+(myYGlobalLo-1)/sNy |
115 |
tn = (jG - 1)*(nPx*nSx) + iG |
116 |
#endif /* ALLOW_EXCH2 */ |
117 |
|
118 |
write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)') |
119 |
& fn(1:ilst),'.',iG,'.',jG,'.data' |
120 |
open( iUnit, file=dataFName, status='unknown', |
121 |
& access='direct', recl=length_of_rec ) |
122 |
|
123 |
irec = 0 |
124 |
C First write single-level turbulence fields |
125 |
do n = 1,nchp |
126 |
r8seg(n) = ctmt(n,bi,bj) |
127 |
enddo |
128 |
#ifdef _BYTESWAPIO |
129 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
130 |
#endif |
131 |
write(iunit,rec=1) r8seg |
132 |
|
133 |
do n = 1,nchp |
134 |
r8seg(n) = xxmt(n,bi,bj) |
135 |
enddo |
136 |
#ifdef _BYTESWAPIO |
137 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
138 |
#endif |
139 |
write(iunit,rec=2) r8seg |
140 |
|
141 |
do n = 1,nchp |
142 |
r8seg(n) = yymt(n,bi,bj) |
143 |
enddo |
144 |
#ifdef _BYTESWAPIO |
145 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
146 |
#endif |
147 |
write(iunit,rec=3) r8seg |
148 |
|
149 |
do n = 1,nchp |
150 |
r8seg(n) = zetamt(n,bi,bj) |
151 |
enddo |
152 |
#ifdef _BYTESWAPIO |
153 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
154 |
#endif |
155 |
write(iunit,rec=4) r8seg |
156 |
|
157 |
C And now write Multi-level turbulence fields |
158 |
do k = 1,Nrphys |
159 |
do n = 1,nchp |
160 |
r8seg(n) = xlmt(n,k,bi,bj) |
161 |
enddo |
162 |
#ifdef _BYTESWAPIO |
163 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
164 |
#endif |
165 |
irec = 4 + 0*Nrphys + k |
166 |
write(iunit,rec=irec) r8seg |
167 |
enddo |
168 |
|
169 |
do k = 1,Nrphys |
170 |
do n = 1,nchp |
171 |
r8seg(n) = khmt(n,k,bi,bj) |
172 |
enddo |
173 |
#ifdef _BYTESWAPIO |
174 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
175 |
#endif |
176 |
irec = 4 + 1*Nrphys + k |
177 |
write(iunit,rec=irec) r8seg |
178 |
enddo |
179 |
|
180 |
do k = 1,Nrphys |
181 |
do n = 1,nchp |
182 |
r8seg(n) = tke(n,k,bi,bj) |
183 |
enddo |
184 |
#ifdef _BYTESWAPIO |
185 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
186 |
#endif |
187 |
irec = 4 + 2*Nrphys + k |
188 |
write(iunit,rec=irec) r8seg |
189 |
enddo |
190 |
|
191 |
C And finally, write land surface fields |
192 |
do n = 1,nchp |
193 |
r8seg(n) = tcanopy(n,bi,bj) |
194 |
enddo |
195 |
#ifdef _BYTESWAPIO |
196 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
197 |
#endif |
198 |
irec = 4 + 3*Nrphys + 1 |
199 |
write(iunit,rec=irec) r8seg |
200 |
|
201 |
do n = 1,nchp |
202 |
r8seg(n) = tdeep(n,bi,bj) |
203 |
enddo |
204 |
#ifdef _BYTESWAPIO |
205 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
206 |
#endif |
207 |
irec = 4 + 3*Nrphys + 2 |
208 |
write(iunit,rec=irec) r8seg |
209 |
|
210 |
do n = 1,nchp |
211 |
r8seg(n) = ecanopy(n,bi,bj) |
212 |
enddo |
213 |
#ifdef _BYTESWAPIO |
214 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
215 |
#endif |
216 |
irec = 4 + 3*Nrphys + 3 |
217 |
write(iunit,rec=irec) r8seg |
218 |
|
219 |
do n = 1,nchp |
220 |
r8seg(n) = swetshal(n,bi,bj) |
221 |
enddo |
222 |
#ifdef _BYTESWAPIO |
223 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
224 |
#endif |
225 |
irec = 4 + 3*Nrphys + 4 |
226 |
write(iunit,rec=irec) r8seg |
227 |
|
228 |
do n = 1,nchp |
229 |
r8seg(n) = swetroot(n,bi,bj) |
230 |
enddo |
231 |
#ifdef _BYTESWAPIO |
232 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
233 |
#endif |
234 |
irec = 4 + 3*Nrphys + 5 |
235 |
write(iunit,rec=irec) r8seg |
236 |
|
237 |
do n = 1,nchp |
238 |
r8seg(n) = swetdeep(n,bi,bj) |
239 |
enddo |
240 |
#ifdef _BYTESWAPIO |
241 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
242 |
#endif |
243 |
irec = 4 + 3*Nrphys + 6 |
244 |
write(iunit,rec=irec) r8seg |
245 |
|
246 |
do n = 1,nchp |
247 |
r8seg(n) = snodep(n,bi,bj) |
248 |
enddo |
249 |
#ifdef _BYTESWAPIO |
250 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
251 |
#endif |
252 |
irec = 4 + 3*Nrphys + 7 |
253 |
write(iunit,rec=irec) r8seg |
254 |
|
255 |
do n = 1,nchp |
256 |
r8seg(n) = capac(n,bi,bj) |
257 |
enddo |
258 |
#ifdef _BYTESWAPIO |
259 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
260 |
#endif |
261 |
irec = 4 + 3*Nrphys + 8 |
262 |
write(iunit,rec=irec) r8seg |
263 |
|
264 |
close(iunit) |
265 |
|
266 |
C End of bi bj loop |
267 |
enddo |
268 |
enddo |
269 |
|
270 |
#endif /* NOT ALLOW_MNC PART */ |
271 |
|
272 |
RETURN |
273 |
END |
274 |
|
275 |
|
276 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
277 |
|
278 |
CBOP |
279 |
C !ROUTINE: FIZHI_READ_VEGTILES |
280 |
C !INTERFACE: |
281 |
SUBROUTINE FIZHI_READ_VEGTILES(Iter,prec,myThid) |
282 |
|
283 |
C !DESCRIPTION: |
284 |
|
285 |
C !USES: |
286 |
IMPLICIT NONE |
287 |
#include "SIZE.h" |
288 |
#include "fizhi_SIZE.h" |
289 |
#include "fizhi_land_SIZE.h" |
290 |
#include "fizhi_coms.h" |
291 |
#include "fizhi_land_coms.h" |
292 |
#include "fizhi_earth_coms.h" |
293 |
#include "EEPARAMS.h" |
294 |
#ifdef ALLOW_MNC |
295 |
#include "MNC_PARAMS.h" |
296 |
#endif |
297 |
#ifdef ALLOW_EXCH2 |
298 |
#include "W2_EXCH2_TOPOLOGY.h" |
299 |
#include "W2_EXCH2_PARAMS.h" |
300 |
#endif /* ALLOW_EXCH2 */ |
301 |
|
302 |
EXTERNAL ILNBLNK |
303 |
INTEGER ILNBLNK |
304 |
INTEGER MDS_RECLEN |
305 |
|
306 |
C !INPUT/OUTPUT PARAMETERS: |
307 |
CHARACTER*1 prec |
308 |
INTEGER Iter |
309 |
INTEGER myThid |
310 |
|
311 |
CEOP |
312 |
C !LOCAL VARIABLES: |
313 |
CHARACTER*(MAX_LEN_FNAM) fn |
314 |
CHARACTER*80 bnam |
315 |
integer ilst |
316 |
character*(80) dataFName |
317 |
integer i,k,n |
318 |
integer ig,jg,tn,iunit |
319 |
integer length_of_rec |
320 |
integer bi,bj,irec,fileprec |
321 |
Real*8 r8seg(nchp) |
322 |
|
323 |
DO i = 1,80 |
324 |
bnam(i:i) = ' ' |
325 |
ENDDO |
326 |
WRITE(fn,'(I10.10)') Iter |
327 |
ilst = ILNBLNK(fn) |
328 |
WRITE(bnam,'(a,a)') 'pickup_vegtiles.', fn(1:ilst) |
329 |
fileprec = 64 |
330 |
prec = 'D' |
331 |
|
332 |
#ifdef ALLOW_MNC |
333 |
IF (useMNC) THEN |
334 |
|
335 |
C Write fizhi veg-space variables using the MNC package |
336 |
CALL MNC_FILE_CLOSE_ALL_MATCHING(bnam, myThid) |
337 |
CALL MNC_CW_SET_UDIM(bnam, 1, myThid) |
338 |
|
339 |
C fizhi_coms.h |
340 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'ctmt', ctmt, myThid) |
341 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'xxmt', xxmt, myThid) |
342 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'yymt', yymt, myThid) |
343 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'zetamt', zetamt, myThid) |
344 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'xlmt', xlmt, myThid) |
345 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'khmt', khmt, myThid) |
346 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'tke', tke, myThid) |
347 |
|
348 |
C fizhi_land_coms.h |
349 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'tcanopy', tcanopy, myThid) |
350 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'tdeep', tdeep, myThid) |
351 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'ecanopy', ecanopy, myThid) |
352 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'swetshal', swetshal, myThid) |
353 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'swetroot', swetroot, myThid) |
354 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'swetdeep', swetdeep, myThid) |
355 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'snodep', snodep, myThid) |
356 |
CALL MNC_CW_RL_R(prec,bnam,0,0,'capac', capac, myThid) |
357 |
|
358 |
ENDIF |
359 |
#else /* Now MDSIO stuff if MNC is off */ |
360 |
|
361 |
call MDSFINDUNIT( iunit, mythid ) |
362 |
length_of_rec=MDS_RECLEN( fileprec, nchp, mythid ) |
363 |
|
364 |
DO bj = myByLo(myThid), myByHi(myThid) |
365 |
DO bi = myBxLo(myThid), myBxHi(myThid) |
366 |
|
367 |
#ifdef ALLOW_EXCH2 |
368 |
tn = W2_myTileList(bi) |
369 |
#else |
370 |
iG = bi+(myXGlobalLo-1)/sNx |
371 |
jG = bj+(myYGlobalLo-1)/sNy |
372 |
tn = (jG - 1)*(nPx*nSx) + iG |
373 |
#endif /* ALLOW_EXCH2 */ |
374 |
|
375 |
write(dataFname(1:80),'(2a,i3.3,a,i3.3,a)') |
376 |
& fn(1:ilst),'.',iG,'.',jG,'.data' |
377 |
open( iUnit, file=dataFName, status='old', |
378 |
& access='direct', recl=length_of_rec ) |
379 |
|
380 |
irec = 0 |
381 |
C First read single-level turbulence fields |
382 |
read(iunit,rec=1) r8seg |
383 |
#ifdef _BYTESWAPIO |
384 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
385 |
#endif |
386 |
do n = 1,nchp |
387 |
ctmt(n,bi,bj) = r8seg(n) |
388 |
enddo |
389 |
|
390 |
read(iunit,rec=2) r8seg |
391 |
#ifdef _BYTESWAPIO |
392 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
393 |
#endif |
394 |
do n = 1,nchp |
395 |
xxmt(n,bi,bj) = r8seg(n) |
396 |
enddo |
397 |
|
398 |
read(iunit,rec=3) r8seg |
399 |
#ifdef _BYTESWAPIO |
400 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
401 |
#endif |
402 |
do n = 1,nchp |
403 |
yymt(n,bi,bj) = r8seg(n) |
404 |
enddo |
405 |
|
406 |
read(iunit,rec=4) r8seg |
407 |
#ifdef _BYTESWAPIO |
408 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
409 |
#endif |
410 |
do n = 1,nchp |
411 |
zetamt(n,bi,bj) = r8seg(n) |
412 |
enddo |
413 |
|
414 |
C And now read Multi-level turbulence fields |
415 |
do k = 1,Nrphys |
416 |
irec = 4 + 0*Nrphys + k |
417 |
read(iunit,rec=irec) r8seg |
418 |
#ifdef _BYTESWAPIO |
419 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
420 |
#endif |
421 |
do n = 1,nchp |
422 |
xlmt(n,k,bi,bj) = r8seg(n) |
423 |
enddo |
424 |
enddo |
425 |
|
426 |
do k = 1,Nrphys |
427 |
irec = 4 + 1*Nrphys + k |
428 |
read(iunit,rec=irec) r8seg |
429 |
#ifdef _BYTESWAPIO |
430 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
431 |
#endif |
432 |
do n = 1,nchp |
433 |
khmt(n,k,bi,bj) = r8seg(n) |
434 |
enddo |
435 |
enddo |
436 |
|
437 |
do k = 1,Nrphys |
438 |
irec = 4 + 2*Nrphys + k |
439 |
read(iunit,rec=irec) r8seg |
440 |
#ifdef _BYTESWAPIO |
441 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
442 |
#endif |
443 |
do n = 1,nchp |
444 |
tke(n,k,bi,bj) = r8seg(n) |
445 |
enddo |
446 |
enddo |
447 |
|
448 |
|
449 |
C And finally, read land surface fields |
450 |
irec = 4 + 3*Nrphys + 1 |
451 |
read(iunit,rec=irec) r8seg |
452 |
#ifdef _BYTESWAPIO |
453 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
454 |
#endif |
455 |
do n = 1,nchp |
456 |
tcanopy(n,bi,bj) = r8seg(n) |
457 |
enddo |
458 |
|
459 |
irec = 4 + 3*Nrphys + 2 |
460 |
read(iunit,rec=irec) r8seg |
461 |
#ifdef _BYTESWAPIO |
462 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
463 |
#endif |
464 |
do n = 1,nchp |
465 |
tdeep(n,bi,bj) = r8seg(n) |
466 |
enddo |
467 |
|
468 |
irec = 4 + 3*Nrphys + 3 |
469 |
read(iunit,rec=irec) r8seg |
470 |
#ifdef _BYTESWAPIO |
471 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
472 |
#endif |
473 |
do n = 1,nchp |
474 |
ecanopy(n,bi,bj) = r8seg(n) |
475 |
enddo |
476 |
|
477 |
irec = 4 + 3*Nrphys + 4 |
478 |
read(iunit,rec=irec) r8seg |
479 |
#ifdef _BYTESWAPIO |
480 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
481 |
#endif |
482 |
do n = 1,nchp |
483 |
swetshal(n,bi,bj) = r8seg(n) |
484 |
enddo |
485 |
|
486 |
irec = 4 + 3*Nrphys + 5 |
487 |
read(iunit,rec=irec) r8seg |
488 |
#ifdef _BYTESWAPIO |
489 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
490 |
#endif |
491 |
do n = 1,nchp |
492 |
swetroot(n,bi,bj) = r8seg(n) |
493 |
enddo |
494 |
|
495 |
irec = 4 + 3*Nrphys + 6 |
496 |
read(iunit,rec=irec) r8seg |
497 |
#ifdef _BYTESWAPIO |
498 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
499 |
#endif |
500 |
do n = 1,nchp |
501 |
swetdeep(n,bi,bj) = r8seg(n) |
502 |
enddo |
503 |
|
504 |
irec = 4 + 3*Nrphys + 7 |
505 |
read(iunit,rec=irec) r8seg |
506 |
#ifdef _BYTESWAPIO |
507 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
508 |
#endif |
509 |
do n = 1,nchp |
510 |
snodep(n,bi,bj) = r8seg(n) |
511 |
enddo |
512 |
|
513 |
irec = 4 + 3*Nrphys + 8 |
514 |
read(iunit,rec=irec) r8seg |
515 |
#ifdef _BYTESWAPIO |
516 |
call MDS_BYTESWAPR8( nchp, r8seg ) |
517 |
#endif |
518 |
do n = 1,nchp |
519 |
capac(n,bi,bj) = r8seg(n) |
520 |
enddo |
521 |
|
522 |
close(iunit) |
523 |
|
524 |
C End of bi bj loop |
525 |
enddo |
526 |
enddo |
527 |
|
528 |
#endif /* Not ALLOW_MNC sequence */ |
529 |
|
530 |
RETURN |
531 |
END |
532 |
|
533 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |