11 |
I filePrec, |
I filePrec, |
12 |
I useCurrentDir, |
I useCurrentDir, |
13 |
I arrType, |
I arrType, |
14 |
I zSize, nNz, |
I kSize,kLo,kHi, |
15 |
O arr, |
O arr, |
16 |
I irecord, |
I irecord, |
17 |
I myThid ) |
I myThid ) |
24 |
C useCurrentDir(logic):: always read from the current directory (even if |
C useCurrentDir(logic):: always read from the current directory (even if |
25 |
C "mdsioLocalDir" is set) |
C "mdsioLocalDir" is set) |
26 |
C arrType (char(2)) :: declaration of "arr": either "RS" or "RL" |
C arrType (char(2)) :: declaration of "arr": either "RS" or "RL" |
27 |
C zSize (integer) :: size of third dimension: normally either 1 or Nr |
C kSize (integer) :: size of third dimension: normally either 1 or Nr |
28 |
C nNz (integer) :: number of vertical levels to read |
C kLo (integer) :: 1rst vertical level (of array "arr") to read-in |
29 |
C arr ( RS/RL ) :: array to read into, arr(:,:,zSize,:,:) |
C kHi (integer) :: last vertical level (of array "arr") to read-in |
30 |
|
C arr ( RS/RL ) :: array to read into, arr(:,:,kSize,:,:) |
31 |
C irecord (integer) :: record number to read |
C irecord (integer) :: record number to read |
32 |
C myIter (integer) :: time step number |
C myIter (integer) :: time step number |
33 |
C myThid (integer) :: thread identifier |
C myThid (integer) :: thread identifier |
34 |
C |
C |
35 |
C MDS_READ_FIELD first checks to see IF the file "fName" exists, then |
C MDS_READ_FIELD first checks to see IF the file "fName" exists, then |
36 |
C IF the file "fName.data" exists and finally the tiled files of the |
C IF the file "fName.data" exists and finally the tiled files of the |
37 |
C form "fName.xxx.yyy.data" exist. Currently, the meta-files are not |
C form "fName.xxx.yyy.data" exist. Currently, the meta-files are not |
38 |
C read because it is difficult to parse files in fortran. |
C read because it is difficult to parse files in fortran. |
39 |
C The precision of the file is decsribed by filePrec, set either |
C The precision of the file is decsribed by filePrec, set either |
40 |
C to floatPrec32 or floatPrec64. The precision or declaration of |
C to floatPrec32 or floatPrec64. The precision or declaration of |
41 |
C the array argument must be consistently described by the char*(2) |
C the array argument must be consistently described by the char*(2) |
42 |
C string arrType, either "RS" or "RL". nNz allows for both 2-D and |
C string arrType, either "RS" or "RL". |
43 |
C 3-D arrays to be handled. nNz=1 implies a 2-D model field and |
C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with |
44 |
C nNz=Nr implies a 3-D model field. irecord is the record number |
C the option to only read and fill-in a sub-set of consecutive vertical |
45 |
C to be read and must be >= 1. The file data is stored in |
C levels (from kLo to kHi) ; (kSize,kLo,kHi)=(1,1,1) implies a 2-D model |
46 |
C arr *but* the overlaps are *not* updated. ie. An exchange must |
C field and (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field. |
47 |
C be called. This is because the routine is sometimes called from |
C irecord is the record number to be read and must be >= 1. |
48 |
C within a MASTER_THID region. |
C The file data is stored in arr *but* the overlaps are *not* updated, |
49 |
|
C i.e., an exchange must be called. This is because the routine is |
50 |
|
C sometimes called from within a MASTER_THID region. |
51 |
C |
C |
52 |
C Created: 03/16/99 adcroft@mit.edu |
C Created: 03/16/99 adcroft@mit.edu |
53 |
CEOP |
CEOP |
70 |
INTEGER filePrec |
INTEGER filePrec |
71 |
LOGICAL useCurrentDir |
LOGICAL useCurrentDir |
72 |
CHARACTER*(2) arrType |
CHARACTER*(2) arrType |
73 |
INTEGER zSize |
INTEGER kSize, kLo, kHi |
|
INTEGER nNz |
|
74 |
INTEGER irecord |
INTEGER irecord |
75 |
INTEGER myThid |
INTEGER myThid |
76 |
C !OUTPUT PARAMETERS: |
C !OUTPUT PARAMETERS: |
90 |
LOGICAL exst |
LOGICAL exst |
91 |
LOGICAL globalFile, fileIsOpen |
LOGICAL globalFile, fileIsOpen |
92 |
LOGICAL iAmDoingIO |
LOGICAL iAmDoingIO |
93 |
INTEGER iG,jG,irec,bi,bj,i,j,k,dUnit,IL,pIL |
INTEGER iG,jG,bi,bj,i,j,k,nNz |
94 |
|
INTEGER irec,dUnit,IL,pIL |
95 |
INTEGER x_size,y_size,length_of_rec |
INTEGER x_size,y_size,length_of_rec |
96 |
#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) |
#if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO) |
97 |
INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo |
INTEGER iG_IO,jG_IO,npe, loc_xGlobalLo, loc_yGlobalLo |
121 |
fileIsOpen = .FALSE. |
fileIsOpen = .FALSE. |
122 |
IL = ILNBLNK( fName ) |
IL = ILNBLNK( fName ) |
123 |
pIL = ILNBLNK( mdsioLocalDir ) |
pIL = ILNBLNK( mdsioLocalDir ) |
124 |
|
nNz = 1 + kHi - kLo |
125 |
|
|
126 |
C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO): |
C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO): |
127 |
iAmDoingIO = MASTER_CPU_IO(myThid) |
iAmDoingIO = MASTER_CPU_IO(myThid) |
140 |
CALL PRINT_ERROR( msgBuf, myThid ) |
CALL PRINT_ERROR( msgBuf, myThid ) |
141 |
STOP 'ABNORMAL END: S/R MDS_READ_FIELD' |
STOP 'ABNORMAL END: S/R MDS_READ_FIELD' |
142 |
ENDIF |
ENDIF |
143 |
|
C check for valid sub-set of levels: |
144 |
|
IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN |
145 |
|
WRITE(msgBuf,'(3(A,I6))') |
146 |
|
& ' MDS_READ_FIELD: arguments kSize=', kSize, |
147 |
|
& ' , kLo=', kLo, ' , kHi=', kHi |
148 |
|
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
149 |
|
& SQUEEZE_RIGHT , myThid) |
150 |
|
WRITE(msgBuf,'(A)') |
151 |
|
& ' MDS_READ_FIELD: invalid sub-set of levels' |
152 |
|
CALL PRINT_ERROR( msgBuf, myThid ) |
153 |
|
STOP 'ABNORMAL END: S/R MDS_READ_FIELD' |
154 |
|
ENDIF |
155 |
|
|
156 |
C Assign special directory |
C Assign special directory |
157 |
IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN |
IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN |
227 |
C- endif iAmDoingIO |
C- endif iAmDoingIO |
228 |
ENDIF |
ENDIF |
229 |
|
|
230 |
DO k=1,nNz |
DO k=kLo,kHi |
231 |
|
|
232 |
C master thread of process 0, only, read from file |
C master thread of process 0, only, read from file |
233 |
IF ( iAmDoingIO ) THEN |
IF ( iAmDoingIO ) THEN |
234 |
irec = k+nNz*(irecord-1) |
irec = k+1-kLo+nNz*(irecord-1) |
235 |
IF (filePrec .EQ. precFloat32) THEN |
IF (filePrec .EQ. precFloat32) THEN |
236 |
READ(dUnit,rec=irec) xy_buffer_r4 |
READ(dUnit,rec=irec) xy_buffer_r4 |
237 |
#ifdef _BYTESWAPIO |
#ifdef _BYTESWAPIO |
319 |
ENDIF |
ENDIF |
320 |
CALL SCATTER_2D(globalBuf,sharedLocalBuf,myThid) |
CALL SCATTER_2D(globalBuf,sharedLocalBuf,myThid) |
321 |
IF (arrType .EQ. 'RS') THEN |
IF (arrType .EQ. 'RS') THEN |
322 |
CALL MDS_PASStoRS( sharedLocalBuf,arr,k,zSize,.TRUE.,myThid ) |
CALL MDS_PASStoRS( sharedLocalBuf,arr,k,kSize,.TRUE.,myThid ) |
323 |
ELSEIF (arrType .EQ. 'RL') THEN |
ELSEIF (arrType .EQ. 'RL') THEN |
324 |
CALL MDS_PASStoRL( sharedLocalBuf,arr,k,zSize,.TRUE.,myThid ) |
CALL MDS_PASStoRL( sharedLocalBuf,arr,k,kSize,.TRUE.,myThid ) |
325 |
ELSE |
ELSE |
326 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
327 |
& ' MDS_READ_FIELD: illegal value for arrType' |
& ' MDS_READ_FIELD: illegal value for arrType' |
330 |
ENDIF |
ENDIF |
331 |
|
|
332 |
ENDDO |
ENDDO |
333 |
c ENDDO k=1,nNz |
c ENDDO k=kLo,kHi |
334 |
|
|
335 |
IF ( iAmDoingIO ) THEN |
IF ( iAmDoingIO ) THEN |
336 |
CLOSE( dUnit ) |
CLOSE( dUnit ) |
412 |
jGjLoc = 1 |
jGjLoc = 1 |
413 |
ENDIF |
ENDIF |
414 |
#endif /* ALLOW_EXCH2 */ |
#endif /* ALLOW_EXCH2 */ |
415 |
DO k=1,nNz |
DO k=kLo,kHi |
416 |
DO j=1,tNy |
DO j=1,tNy |
417 |
IF (globalFile) THEN |
IF (globalFile) THEN |
418 |
#ifdef ALLOW_EXCH2 |
#ifdef ALLOW_EXCH2 |
419 |
irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx |
irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx |
420 |
& + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt |
& + ( tGy-1 + (j-1)*jGjLoc )*exch2_domain_nxt |
421 |
& + ( k-1 + (irecord-1)*nNz |
& + ( k-kLo + (irecord-1)*nNz |
422 |
& )*y_size*exch2_domain_nxt |
& )*y_size*exch2_domain_nxt |
423 |
#else /* ALLOW_EXCH2 */ |
#else /* ALLOW_EXCH2 */ |
424 |
iG = myXGlobalLo-1 + (bi-1)*sNx |
iG = myXGlobalLo-1 + (bi-1)*sNx |
425 |
jG = myYGlobalLo-1 + (bj-1)*sNy |
jG = myYGlobalLo-1 + (bj-1)*sNy |
426 |
irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) |
irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1) |
427 |
& + nSx*nPx*Ny*(k-1) |
& + nSx*nPx*Ny*(k-kLo) |
428 |
& + nSx*nPx*Ny*nNz*(irecord-1) |
& + nSx*nPx*Ny*nNz*(irecord-1) |
429 |
#endif /* ALLOW_EXCH2 */ |
#endif /* ALLOW_EXCH2 */ |
430 |
ELSE |
ELSE |
431 |
irec=j + sNy*(k-1) + sNy*nNz*(irecord-1) |
irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1) |
432 |
ENDIF |
ENDIF |
433 |
IF (filePrec .EQ. precFloat32) THEN |
IF (filePrec .EQ. precFloat32) THEN |
434 |
READ(dUnit,rec=irec) r4seg |
READ(dUnit,rec=irec) r4seg |
436 |
CALL MDS_BYTESWAPR4( sNx, r4seg ) |
CALL MDS_BYTESWAPR4( sNx, r4seg ) |
437 |
#endif |
#endif |
438 |
IF (arrType .EQ. 'RS') THEN |
IF (arrType .EQ. 'RS') THEN |
439 |
CALL MDS_SEG4toRS( j,bi,bj,k,zSize, r4seg, .TRUE., arr ) |
CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg, .TRUE., arr ) |
440 |
ELSEIF (arrType .EQ. 'RL') THEN |
ELSEIF (arrType .EQ. 'RL') THEN |
441 |
CALL MDS_SEG4toRL( j,bi,bj,k,zSize, r4seg, .TRUE., arr ) |
CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg, .TRUE., arr ) |
442 |
ELSE |
ELSE |
443 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
444 |
& ' MDS_READ_FIELD: illegal value for arrType' |
& ' MDS_READ_FIELD: illegal value for arrType' |
451 |
CALL MDS_BYTESWAPR8( sNx, r8seg ) |
CALL MDS_BYTESWAPR8( sNx, r8seg ) |
452 |
#endif |
#endif |
453 |
IF (arrType .EQ. 'RS') THEN |
IF (arrType .EQ. 'RS') THEN |
454 |
CALL MDS_SEG8toRS( j,bi,bj,k,zSize, r8seg, .TRUE., arr ) |
CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg, .TRUE., arr ) |
455 |
ELSEIF (arrType .EQ. 'RL') THEN |
ELSEIF (arrType .EQ. 'RL') THEN |
456 |
CALL MDS_SEG8toRL( j,bi,bj,k,zSize, r8seg, .TRUE., arr ) |
CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg, .TRUE., arr ) |
457 |
ELSE |
ELSE |
458 |
WRITE(msgBuf,'(A)') |
WRITE(msgBuf,'(A)') |
459 |
& ' MDS_READ_FIELD: illegal value for arrType' |
& ' MDS_READ_FIELD: illegal value for arrType' |