/[MITgcm]/MITgcm/pkg/mdsio/mdsio_read_field.F
ViewVC logotype

Diff of /MITgcm/pkg/mdsio/mdsio_read_field.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by jmc, Mon Mar 19 02:30:49 2007 UTC revision 1.3 by jmc, Tue Nov 13 19:37:44 2007 UTC
# Line 11  C !INTERFACE: Line 11  C !INTERFACE:
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 )
# Line 24  C filePrec  (integer) :: number of bits Line 24  C filePrec  (integer) :: number of bits
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
# Line 67  C !INPUT PARAMETERS: Line 70  C !INPUT PARAMETERS:
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:
# Line 88  C !LOCAL VARIABLES: Line 90  C !LOCAL VARIABLES:
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
# Line 118  C Assume nothing Line 121  C Assume nothing
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)
# Line 136  C Record number must be >= 1 Line 140  C Record number must be >= 1
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
# Line 211  C Otherwise stop program. Line 227  C Otherwise stop program.
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
# Line 303  C- endif iAmDoingIO Line 319  C- endif iAmDoingIO
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'
# Line 314  C- endif iAmDoingIO Line 330  C- endif iAmDoingIO
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 )
# Line 396  C-         default (face fit into global Line 412  C-         default (face fit into global
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
# Line 420  C-         default (face fit into global Line 436  C-         default (face fit into global
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'
# Line 435  C-         default (face fit into global Line 451  C-         default (face fit into global
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'
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22