1 |
C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_slice.F,v 1.13 2009/08/05 23:17:54 jmc Exp $ |
2 |
C $Name: $ |
3 |
|
4 |
#include "MDSIO_OPTIONS.h" |
5 |
|
6 |
C-- File mdsio_read_section.F: Routines to handle mid-level I/O interface. |
7 |
C-- Contents |
8 |
C-- o MDS_READ_SEC_XZ |
9 |
C-- o MDS_READ_SEC_YZ |
10 |
|
11 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
12 |
|
13 |
CBOP |
14 |
C !ROUTINE: MDS_READ_SEC_XZ |
15 |
C !INTERFACE: |
16 |
SUBROUTINE MDS_READ_SEC_XZ( |
17 |
I fName, |
18 |
I filePrec, |
19 |
I useCurrentDir, |
20 |
I arrType, |
21 |
I kSize, |
22 |
O fldRL, fldRS, |
23 |
I irecord, |
24 |
I myThid ) |
25 |
|
26 |
C !DESCRIPTION |
27 |
C Arguments: |
28 |
C |
29 |
C fName string :: base name for file to read |
30 |
C filePrec integer :: number of bits per word in file (32 or 64) |
31 |
C useCurrentDir(logic):: always read from the current directory (even if |
32 |
C "mdsioLocalDir" is set) |
33 |
C arrType char(2) :: which array (fldRL/RS) to read into, either "RL" or "RS |
34 |
C kSize integer :: size of third dimension, normally either 1 or Nr |
35 |
C fldRL RL :: array to read into if arrType="RL", fldRL(:,kSize,:,:) |
36 |
C fldRS RS :: array to read into if arrType="RS", fldRS(:,kSize,:,:) |
37 |
C irecord integer :: record number to read |
38 |
C myThid integer :: thread identifier |
39 |
C |
40 |
C MDS_READ_SEC_XZ first checks to see IF the file "fName" exists, then |
41 |
C if the file "fName.data" exists and finally the tiled files of the |
42 |
C form "fName.xxx.yyy.data" exist. |
43 |
C The precision of the file is decsribed by filePrec, set either |
44 |
C to floatPrec32 or floatPrec64. The char*(2) string arrType, either "RL" |
45 |
C or "RS", selects which array is filled in, either fldRL or fldRS. |
46 |
C This routine reads vertical slices (X-Z) including the overlap region. |
47 |
C irecord is the record number to be read and must be >= 1. |
48 |
C The file data is stored in fldRL/RS *but* the overlaps are *not* updated. |
49 |
C |
50 |
C Created: 06/03/00 spk@ocean.mit.edu |
51 |
CEOP |
52 |
|
53 |
C !USES: |
54 |
IMPLICIT NONE |
55 |
C Global variables / common blocks |
56 |
#include "SIZE.h" |
57 |
#include "EEPARAMS.h" |
58 |
#include "PARAMS.h" |
59 |
|
60 |
C !INPUT PARAMETERS: |
61 |
CHARACTER*(*) fName |
62 |
INTEGER filePrec |
63 |
LOGICAL useCurrentDir |
64 |
CHARACTER*(2) arrType |
65 |
INTEGER kSize |
66 |
INTEGER irecord |
67 |
INTEGER myThid |
68 |
C !OUTPUT PARAMETERS: |
69 |
_RL fldRL(*) |
70 |
_RS fldRS(*) |
71 |
|
72 |
C !FUNCTIONS: |
73 |
INTEGER ILNBLNK |
74 |
INTEGER MDS_RECLEN |
75 |
EXTERNAL ILNBLNK, MDS_RECLEN |
76 |
|
77 |
C !LOCAL VARIABLES: |
78 |
CHARACTER*(MAX_LEN_FNAM) dataFName,pfName |
79 |
INTEGER iG,jG,irec,bi,bj,k,dUnit,IL,pIL |
80 |
LOGICAL exst |
81 |
Real*4 r4seg(sNx) |
82 |
Real*8 r8seg(sNx) |
83 |
LOGICAL globalFile,fileIsOpen |
84 |
INTEGER length_of_rec |
85 |
CHARACTER*(max_len_mbuf) msgBuf |
86 |
C ------------------------------------------------------------------ |
87 |
|
88 |
C Only do I/O if I am the master thread |
89 |
_BEGIN_MASTER( myThid ) |
90 |
|
91 |
C Record number must be >= 1 |
92 |
IF (irecord .LT. 1) THEN |
93 |
WRITE(msgBuf,'(A,I9.8)') |
94 |
& ' MDS_READ_SEC_XZ: argument irecord = ',irecord |
95 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
96 |
& SQUEEZE_RIGHT, myThid ) |
97 |
WRITE(msgBuf,'(A)') |
98 |
& ' MDS_READ_SEC_XZ: Invalid value for irecord' |
99 |
CALL PRINT_ERROR( msgBuf, myThid ) |
100 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ' |
101 |
ENDIF |
102 |
|
103 |
C Assume nothing |
104 |
globalFile = .FALSE. |
105 |
fileIsOpen = .FALSE. |
106 |
IL = ILNBLNK( fName ) |
107 |
pIL = ILNBLNK( mdsioLocalDir ) |
108 |
|
109 |
C Assign special directory |
110 |
IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN |
111 |
pfName= fName |
112 |
ELSE |
113 |
WRITE(pfName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL) |
114 |
ENDIF |
115 |
pIL=ILNBLNK( pfName ) |
116 |
|
117 |
C Assign a free unit number as the I/O channel for this routine |
118 |
CALL MDSFINDUNIT( dUnit, myThid ) |
119 |
|
120 |
C Check first for global file with simple name (ie. fName) |
121 |
dataFName = fName |
122 |
INQUIRE( file=dataFName, exist=exst ) |
123 |
IF (exst) THEN |
124 |
IF ( debugLevel .GE. debLevA ) THEN |
125 |
WRITE(msgBuf,'(A,A)') |
126 |
& ' MDS_READ_SEC_XZ: opening global file: ',dataFName(1:IL) |
127 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
128 |
& SQUEEZE_RIGHT, myThid ) |
129 |
ENDIF |
130 |
globalFile = .TRUE. |
131 |
ENDIF |
132 |
|
133 |
C If negative check for global file with MDS name (ie. fName.data) |
134 |
IF (.NOT. globalFile) THEN |
135 |
WRITE(dataFName,'(2A)') fName(1:IL),'.data' |
136 |
INQUIRE( file=dataFName, exist=exst ) |
137 |
IF (exst) THEN |
138 |
IF ( debugLevel .GE. debLevA ) THEN |
139 |
WRITE(msgBuf,'(A,A)') |
140 |
& ' MDS_READ_SEC_XZ: opening global file: ',dataFName(1:IL+5) |
141 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
142 |
& SQUEEZE_RIGHT, myThid ) |
143 |
ENDIF |
144 |
globalFile = .TRUE. |
145 |
ENDIF |
146 |
ENDIF |
147 |
|
148 |
C If we are reading from a global file then we open it here |
149 |
IF (globalFile) THEN |
150 |
length_of_rec = MDS_RECLEN( filePrec, sNx, myThid ) |
151 |
OPEN( dUnit, file=dataFName, status='old', |
152 |
& access='direct', recl=length_of_rec ) |
153 |
fileIsOpen=.TRUE. |
154 |
ENDIF |
155 |
|
156 |
C Loop over all tiles |
157 |
DO bj=1,nSy |
158 |
DO bi=1,nSx |
159 |
C If we are reading from a tiled MDS file then we open each one here |
160 |
IF (.NOT. globalFile) THEN |
161 |
iG=bi+(myXGlobalLo-1)/sNx |
162 |
jG=bj+(myYGlobalLo-1)/sNy |
163 |
WRITE(dataFName,'(2A,I3.3,A,I3.3,A)') |
164 |
& pfName(1:pIL),'.',iG,'.',jG,'.data' |
165 |
INQUIRE( file=dataFName, exist=exst ) |
166 |
C Of course, we only open the file IF the tile is "active" |
167 |
C (This is a place-holder for the active/passive mechanism |
168 |
IF (exst) THEN |
169 |
IF ( debugLevel .GE. debLevA ) THEN |
170 |
WRITE(msgBuf,'(A,A)') |
171 |
& ' MDS_READ_SEC_XZ: opening file: ',dataFName(1:pIL+13) |
172 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
173 |
& SQUEEZE_RIGHT, myThid ) |
174 |
ENDIF |
175 |
length_of_rec = MDS_RECLEN( filePrec, sNx, myThid ) |
176 |
OPEN( dUnit, file=dataFName, status='old', |
177 |
& access='direct', recl=length_of_rec ) |
178 |
fileIsOpen=.TRUE. |
179 |
ELSE |
180 |
fileIsOpen=.FALSE. |
181 |
WRITE(msgBuf,'(4A)') ' MDS_READ_SEC_XZ: filename: ', |
182 |
& fName(1:IL),' , ', dataFName(1:pIL+13) |
183 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
184 |
& SQUEEZE_RIGHT, myThid ) |
185 |
WRITE(msgBuf,'(A)') |
186 |
& ' MDS_READ_SEC_XZ: Files DO not exist' |
187 |
CALL PRINT_ERROR( msgBuf, myThid ) |
188 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ' |
189 |
ENDIF |
190 |
ENDIF |
191 |
|
192 |
IF (fileIsOpen) THEN |
193 |
DO k=1,kSize |
194 |
IF (globalFile) THEN |
195 |
iG = myXGlobalLo-1 + (bi-1)*sNx |
196 |
jG = (myYGlobalLo-1)/sNy + (bj-1) |
197 |
irec=1 + INT(iG/sNx) + nSx*nPx*(k-1) |
198 |
& + nSx*nPx*kSize*(irecord-1) |
199 |
ELSE |
200 |
iG = 0 |
201 |
jG = 0 |
202 |
irec=k + kSize*(irecord-1) |
203 |
ENDIF |
204 |
IF (filePrec .EQ. precFloat32) THEN |
205 |
READ(dUnit,rec=irec) r4seg |
206 |
#ifdef _BYTESWAPIO |
207 |
CALL MDS_BYTESWAPR4(sNx,r4seg) |
208 |
#endif |
209 |
IF (arrType .EQ. 'RS') THEN |
210 |
CALL MDS_SEG4toRS_2D( sNx,oLx,kSize,bi,bj,k,.TRUE., |
211 |
& r4seg,fldRS ) |
212 |
ELSEIF (arrType .EQ. 'RL') THEN |
213 |
CALL MDS_SEG4toRL_2D( sNx,oLx,kSize,bi,bj,k,.TRUE., |
214 |
& r4seg,fldRL ) |
215 |
ELSE |
216 |
WRITE(msgBuf,'(A)') |
217 |
& ' MDS_READ_SEC_XZ: illegal value for arrType' |
218 |
CALL PRINT_ERROR( msgBuf, myThid ) |
219 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ' |
220 |
ENDIF |
221 |
ELSEIF (filePrec .EQ. precFloat64) THEN |
222 |
READ(dUnit,rec=irec) r8seg |
223 |
#ifdef _BYTESWAPIO |
224 |
CALL MDS_BYTESWAPR8( sNx, r8seg ) |
225 |
#endif |
226 |
IF (arrType .EQ. 'RS') THEN |
227 |
CALL MDS_SEG8toRS_2D(sNx,oLx,kSize,bi,bj,k,.TRUE., |
228 |
& r8seg,fldRS ) |
229 |
ELSEIF (arrType .EQ. 'RL') THEN |
230 |
CALL MDS_SEG8toRL_2D(sNx,oLx,kSize,bi,bj,k,.TRUE., |
231 |
& r8seg,fldRL ) |
232 |
ELSE |
233 |
WRITE(msgBuf,'(A)') |
234 |
& ' MDS_READ_SEC_XZ: illegal value for arrType' |
235 |
CALL PRINT_ERROR( msgBuf, myThid ) |
236 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ' |
237 |
ENDIF |
238 |
ELSE |
239 |
WRITE(msgBuf,'(A)') |
240 |
& ' MDS_READ_SEC_XZ: illegal value for filePrec' |
241 |
CALL PRINT_ERROR( msgBuf, myThid ) |
242 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ' |
243 |
ENDIF |
244 |
C End of k loop |
245 |
ENDDO |
246 |
IF (.NOT. globalFile) THEN |
247 |
CLOSE( dUnit ) |
248 |
fileIsOpen = .FALSE. |
249 |
ENDIF |
250 |
ENDIF |
251 |
C End of bi,bj loops |
252 |
ENDDO |
253 |
ENDDO |
254 |
|
255 |
C If global file was opened then close it |
256 |
IF (fileIsOpen .AND. globalFile) THEN |
257 |
CLOSE( dUnit ) |
258 |
fileIsOpen = .FALSE. |
259 |
ENDIF |
260 |
|
261 |
_END_MASTER( myThid ) |
262 |
|
263 |
C ------------------------------------------------------------------ |
264 |
RETURN |
265 |
END |
266 |
|
267 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
268 |
|
269 |
CBOP |
270 |
C !ROUTINE: MDS_READ_SEC_YZ |
271 |
C !INTERFACE: |
272 |
SUBROUTINE MDS_READ_SEC_YZ( |
273 |
I fName, |
274 |
I filePrec, |
275 |
I useCurrentDir, |
276 |
I arrType, |
277 |
I kSize, |
278 |
O fldRL, fldRS, |
279 |
I irecord, |
280 |
I myThid ) |
281 |
|
282 |
C !DESCRIPTION |
283 |
C Arguments: |
284 |
C |
285 |
C fName string :: base name for file to read |
286 |
C filePrec integer :: number of bits per word in file (32 or 64) |
287 |
C useCurrentDir(logic):: always read from the current directory (even if |
288 |
C "mdsioLocalDir" is set) |
289 |
C arrType char(2) :: which array (fldRL/RS) to read into, either "RL" or "RS |
290 |
C kSize integer :: size of third dimension, normally either 1 or Nr |
291 |
C fldRL RL :: array to read into if arrType="RL", fldRL(:,kSize,:,:) |
292 |
C fldRS RS :: array to read into if arrType="RS", fldRS(:,kSize,:,:) |
293 |
C irecord integer :: record number to read |
294 |
C myThid integer :: thread identifier |
295 |
C |
296 |
C MDS_READ_SEC_YZ first checks to see IF the file "fName" exists, then |
297 |
C if the file "fName.data" exists and finally the tiled files of the |
298 |
C form "fName.xxx.yyy.data" exist. |
299 |
C The precision of the file is decsribed by filePrec, set either |
300 |
C to floatPrec32 or floatPrec64. The char*(2) string arrType, either "RL" |
301 |
C or "RS", selects which array is filled in, either fldRL or fldRS. |
302 |
C This routine reads vertical slices (Y-Z) including the overlap region. |
303 |
C irecord is the record number to be read and must be >= 1. |
304 |
C The file data is stored in fldRL/RS *but* the overlaps are *not* updated. |
305 |
C |
306 |
C Created: 06/03/00 spk@ocean.mit.edu |
307 |
CEOP |
308 |
|
309 |
C !USES: |
310 |
IMPLICIT NONE |
311 |
C Global variables / common blocks |
312 |
#include "SIZE.h" |
313 |
#include "EEPARAMS.h" |
314 |
#include "PARAMS.h" |
315 |
|
316 |
C !INPUT PARAMETERS: |
317 |
CHARACTER*(*) fName |
318 |
INTEGER filePrec |
319 |
LOGICAL useCurrentDir |
320 |
CHARACTER*(2) arrType |
321 |
INTEGER kSize |
322 |
INTEGER irecord |
323 |
INTEGER myThid |
324 |
C !OUTPUT PARAMETERS: |
325 |
_RL fldRL(*) |
326 |
_RS fldRS(*) |
327 |
|
328 |
C !FUNCTIONS: |
329 |
INTEGER ILNBLNK |
330 |
INTEGER MDS_RECLEN |
331 |
EXTERNAL ILNBLNK, MDS_RECLEN |
332 |
|
333 |
C !LOCAL VARIABLES: |
334 |
CHARACTER*(MAX_LEN_FNAM) dataFName,pfName |
335 |
INTEGER iG,jG,irec,bi,bj,k,dUnit,IL,pIL |
336 |
LOGICAL exst |
337 |
Real*4 r4seg(sNy) |
338 |
Real*8 r8seg(sNy) |
339 |
LOGICAL globalFile,fileIsOpen |
340 |
INTEGER length_of_rec |
341 |
CHARACTER*(max_len_mbuf) msgBuf |
342 |
C ------------------------------------------------------------------ |
343 |
|
344 |
C Only do I/O if I am the master thread |
345 |
_BEGIN_MASTER( myThid ) |
346 |
|
347 |
C Record number must be >= 1 |
348 |
IF (irecord .LT. 1) THEN |
349 |
WRITE(msgBuf,'(A,I9.8)') |
350 |
& ' MDS_READ_SEC_YZ: argument irecord = ',irecord |
351 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
352 |
& SQUEEZE_RIGHT, myThid ) |
353 |
WRITE(msgBuf,'(A)') |
354 |
& ' MDS_READ_SEC_YZ: Invalid value for irecord' |
355 |
CALL PRINT_ERROR( msgBuf, myThid ) |
356 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ' |
357 |
ENDIF |
358 |
|
359 |
C Assume nothing |
360 |
globalFile = .FALSE. |
361 |
fileIsOpen = .FALSE. |
362 |
IL = ILNBLNK( fName ) |
363 |
pIL = ILNBLNK( mdsioLocalDir ) |
364 |
|
365 |
C Assign special directory |
366 |
IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN |
367 |
pfName= fName |
368 |
ELSE |
369 |
WRITE(pfName,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL) |
370 |
ENDIF |
371 |
pIL=ILNBLNK( pfName ) |
372 |
|
373 |
C Assign a free unit number as the I/O channel for this routine |
374 |
CALL MDSFINDUNIT( dUnit, myThid ) |
375 |
|
376 |
C Check first for global file with simple name (ie. fName) |
377 |
dataFName = fName |
378 |
INQUIRE( file=dataFName, exist=exst ) |
379 |
IF (exst) THEN |
380 |
IF ( debugLevel .GE. debLevA ) THEN |
381 |
WRITE(msgBuf,'(A,A)') |
382 |
& ' MDS_READ_SEC_YZ: opening global file: ',dataFName(1:IL) |
383 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
384 |
& SQUEEZE_RIGHT, myThid ) |
385 |
ENDIF |
386 |
globalFile = .TRUE. |
387 |
ENDIF |
388 |
|
389 |
C If negative check for global file with MDS name (ie. fName.data) |
390 |
IF (.NOT. globalFile) THEN |
391 |
WRITE(dataFName,'(2A)') fName(1:IL),'.data' |
392 |
INQUIRE( file=dataFName, exist=exst ) |
393 |
IF (exst) THEN |
394 |
IF ( debugLevel .GE. debLevA ) THEN |
395 |
WRITE(msgBuf,'(A,A)') |
396 |
& ' MDS_READ_SEC_YZ: opening global file: ',dataFName(1:IL+5) |
397 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
398 |
& SQUEEZE_RIGHT, myThid ) |
399 |
ENDIF |
400 |
globalFile = .TRUE. |
401 |
ENDIF |
402 |
ENDIF |
403 |
|
404 |
C If we are reading from a global file then we open it here |
405 |
IF (globalFile) THEN |
406 |
length_of_rec = MDS_RECLEN( filePrec, sNy, myThid ) |
407 |
OPEN( dUnit, file=dataFName, status='old', |
408 |
& access='direct', recl=length_of_rec ) |
409 |
fileIsOpen=.TRUE. |
410 |
ENDIF |
411 |
|
412 |
C Loop over all tiles |
413 |
DO bj=1,nSy |
414 |
DO bi=1,nSx |
415 |
C If we are reading from a tiled MDS file then we open each one here |
416 |
IF (.NOT. globalFile) THEN |
417 |
iG=bi+(myXGlobalLo-1)/sNx |
418 |
jG=bj+(myYGlobalLo-1)/sNy |
419 |
WRITE(dataFName,'(2A,I3.3,A,I3.3,A)') |
420 |
& pfName(1:pIL),'.',iG,'.',jG,'.data' |
421 |
INQUIRE( file=dataFName, exist=exst ) |
422 |
C Of course, we only open the file IF the tile is "active" |
423 |
C (This is a place-holder for the active/passive mechanism |
424 |
IF (exst) THEN |
425 |
IF ( debugLevel .GE. debLevA ) THEN |
426 |
WRITE(msgBuf,'(A,A)') |
427 |
& ' MDS_READ_SEC_YZ: opening file: ',dataFName(1:pIL+13) |
428 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
429 |
& SQUEEZE_RIGHT, myThid ) |
430 |
ENDIF |
431 |
length_of_rec = MDS_RECLEN( filePrec, sNy, myThid ) |
432 |
OPEN( dUnit, file=dataFName, status='old', |
433 |
& access='direct', recl=length_of_rec ) |
434 |
fileIsOpen=.TRUE. |
435 |
ELSE |
436 |
fileIsOpen=.FALSE. |
437 |
WRITE(msgBuf,'(4A)') ' MDS_READ_SEC_YZ: filename: ', |
438 |
& fName(1:IL),' , ', dataFName(1:pIL+13) |
439 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
440 |
& SQUEEZE_RIGHT, myThid ) |
441 |
WRITE(msgBuf,'(A)') |
442 |
& ' MDS_READ_SEC_YZ: Files DO not exist' |
443 |
CALL PRINT_ERROR( msgBuf, myThid ) |
444 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ' |
445 |
ENDIF |
446 |
ENDIF |
447 |
|
448 |
IF (fileIsOpen) THEN |
449 |
DO k=1,kSize |
450 |
IF (globalFile) THEN |
451 |
iG = (myXGlobalLo-1)/sNx + (bi-1) |
452 |
jG = myYGlobalLo-1 + (bj-1)*sNy |
453 |
irec=1 + INT(jG/sNy) + nSy*nPy*(k-1) |
454 |
& + nSy*nPy*kSize*(irecord-1) |
455 |
ELSE |
456 |
iG = 0 |
457 |
jG = 0 |
458 |
irec=k + kSize*(irecord-1) |
459 |
ENDIF |
460 |
IF (filePrec .EQ. precFloat32) THEN |
461 |
READ(dUnit,rec=irec) r4seg |
462 |
#ifdef _BYTESWAPIO |
463 |
CALL MDS_BYTESWAPR4(sNy,r4seg) |
464 |
#endif |
465 |
IF (arrType .EQ. 'RS') THEN |
466 |
CALL MDS_SEG4toRS_2D( sNy,oLy,kSize,bi,bj,k,.TRUE., |
467 |
& r4seg,fldRS ) |
468 |
ELSEIF (arrType .EQ. 'RL') THEN |
469 |
CALL MDS_SEG4toRL_2D( sNy,oLy,kSize,bi,bj,k,.TRUE., |
470 |
& r4seg,fldRL ) |
471 |
ELSE |
472 |
WRITE(msgBuf,'(A)') |
473 |
& ' MDS_READ_SEC_YZ: illegal value for arrType' |
474 |
CALL PRINT_ERROR( msgBuf, myThid ) |
475 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ' |
476 |
ENDIF |
477 |
ELSEIF (filePrec .EQ. precFloat64) THEN |
478 |
READ(dUnit,rec=irec) r8seg |
479 |
#ifdef _BYTESWAPIO |
480 |
CALL MDS_BYTESWAPR8( sNy, r8seg ) |
481 |
#endif |
482 |
IF (arrType .EQ. 'RS') THEN |
483 |
CALL MDS_SEG8toRS_2D( sNy,oLy,kSize,bi,bj,k,.TRUE., |
484 |
& r8seg,fldRS ) |
485 |
ELSEIF (arrType .EQ. 'RL') THEN |
486 |
CALL MDS_SEG8toRL_2D( sNy,oLy,kSize,bi,bj,k,.TRUE., |
487 |
& r8seg,fldRL ) |
488 |
ELSE |
489 |
WRITE(msgBuf,'(A)') |
490 |
& ' MDS_READ_SEC_YZ: illegal value for arrType' |
491 |
CALL PRINT_ERROR( msgBuf, myThid ) |
492 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ' |
493 |
ENDIF |
494 |
ELSE |
495 |
WRITE(msgBuf,'(A)') |
496 |
& ' MDS_READ_SEC_YZ: illegal value for filePrec' |
497 |
CALL PRINT_ERROR( msgBuf, myThid ) |
498 |
STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ' |
499 |
ENDIF |
500 |
C End of k loop |
501 |
ENDDO |
502 |
IF (.NOT. globalFile) THEN |
503 |
CLOSE( dUnit ) |
504 |
fileIsOpen = .FALSE. |
505 |
ENDIF |
506 |
ENDIF |
507 |
C End of bi,bj loops |
508 |
ENDDO |
509 |
ENDDO |
510 |
|
511 |
C If global file was opened then close it |
512 |
IF (fileIsOpen .AND. globalFile) THEN |
513 |
CLOSE( dUnit ) |
514 |
fileIsOpen = .FALSE. |
515 |
ENDIF |
516 |
|
517 |
_END_MASTER( myThid ) |
518 |
|
519 |
C ------------------------------------------------------------------ |
520 |
RETURN |
521 |
END |