/[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.8 by jmc, Sat May 16 13:37:38 2009 UTC revision 1.9 by jmc, Mon Jun 1 14:20:31 2009 UTC
# Line 97  C !LOCAL VARIABLES: Line 97  C !LOCAL VARIABLES:
97        INTEGER length_of_rec        INTEGER length_of_rec
98        Real*4 r4seg(sNx)        Real*4 r4seg(sNx)
99        Real*8 r8seg(sNx)        Real*8 r8seg(sNx)
100          Real*4 r4loc(sNx,sNy)
101          Real*8 r8loc(sNx,sNy)
102        INTEGER tNx, tNy, global_nTx        INTEGER tNx, tNy, global_nTx
103        INTEGER tBx, tBy, iGjLoc, jGjLoc        INTEGER tBx, tBy, iGjLoc, jGjLoc
104  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
# Line 208  C master thread of process 0, only, open Line 210  C master thread of process 0, only, open
210  C If global file is visible to process 0, then open it here.  C If global file is visible to process 0, then open it here.
211  C Otherwise stop program.  C Otherwise stop program.
212           IF ( globalFile) THEN           IF ( globalFile) THEN
213            length_of_rec=MDS_RECLEN( filePrec, xSize*ySize, myThid )            length_of_rec = MDS_RECLEN( filePrec, xSize*ySize, myThid )
214            OPEN( dUnit, file=dataFName, status='old',            OPEN( dUnit, file=dataFName, status='old',
215       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
216           ELSE           ELSE
# Line 231  C- endif iAmDoingIO Line 233  C- endif iAmDoingIO
233    
234  C master thread of process 0, only, read from file  C master thread of process 0, only, read from file
235          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
236            irec = k+1-kLo+nNz*(irecord-1)            irec = 1 + k-kLo + (irecord-1)*nNz
237            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
238             READ(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )             READ(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
239  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 258  C- endif iAmDoingIO Line 260  C- endif iAmDoingIO
260       I                        xSize, ySize,       I                        xSize, ySize,
261       I                        useExch2ioLayOut, .FALSE., myThid )       I                        useExch2ioLayOut, .FALSE., myThid )
262            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
263              CALL MDS_PASS_R4toRS( sharedLocBuf_r4,              CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
264       &                            arr, k, kSize, .TRUE., myThid )       I                            k, kSize, 0, 0, .TRUE., myThid )
265            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
266              CALL MDS_PASS_R4toRL( sharedLocBuf_r4,              CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
267       &                            arr, k, kSize, .TRUE., myThid )       I                            k, kSize, 0, 0, .TRUE., myThid )
268            ELSE            ELSE
269              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
270       &          ' MDS_READ_FIELD: illegal value for arrType'       &          ' MDS_READ_FIELD: illegal value for arrType'
# Line 276  C- endif iAmDoingIO Line 278  C- endif iAmDoingIO
278       I                        xSize, ySize,       I                        xSize, ySize,
279       I                        useExch2ioLayOut, .FALSE., myThid )       I                        useExch2ioLayOut, .FALSE., myThid )
280            IF ( arrType.EQ.'RS' ) THEN            IF ( arrType.EQ.'RS' ) THEN
281              CALL MDS_PASS_R8toRS( sharedLocBuf_r8,              CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
282       &                            arr, k, kSize, .TRUE., myThid )       I                            k, kSize, 0, 0, .TRUE., myThid )
283            ELSEIF ( arrType.EQ.'RL' ) THEN            ELSEIF ( arrType.EQ.'RL' ) THEN
284              CALL MDS_PASS_R8toRL( sharedLocBuf_r8,              CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
285       &                            arr, k, kSize, .TRUE., myThid )       I                            k, kSize, 0, 0, .TRUE., myThid )
286            ELSE            ELSE
287              WRITE(msgBuf,'(A)')              WRITE(msgBuf,'(A)')
288       &          ' MDS_READ_FIELD: illegal value for arrType'       &          ' MDS_READ_FIELD: illegal value for arrType'
# Line 305  C Only do I/O if I am the master thread Line 307  C Only do I/O if I am the master thread
307    
308  C If we are reading from a global file then we open it here  C If we are reading from a global file then we open it here
309          IF (globalFile) THEN          IF (globalFile) THEN
310           length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
311           OPEN( dUnit, file=dataFName, status='old',           OPEN( dUnit, file=dataFName, status='old',
312       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
313           fileIsOpen=.TRUE.           fileIsOpen=.TRUE.
# Line 314  C If we are reading from a global file t Line 316  C If we are reading from a global file t
316  C Loop over all tiles  C Loop over all tiles
317          DO bj=1,nSy          DO bj=1,nSy
318           DO bi=1,nSx           DO bi=1,nSx
 C If we are reading from a tiled MDS file then we open each one here  
           IF (.NOT. globalFile) THEN  
            iG=bi+(myXGlobalLo-1)/sNx  
            jG=bj+(myYGlobalLo-1)/sNy  
            WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')  
      &            pfName(1:pIL),'.',iG,'.',jG,'.data'  
            INQUIRE( file=dataFName, exist=exst )  
 C Of course, we only open the file if the tile is "active"  
 C (This is a place-holder for the active/passive mechanism  
            IF (exst) THEN  
             IF ( debugLevel .GE. debLevA ) THEN  
              WRITE(msgBuf,'(A,A)')  
      &       ' MDS_READ_FIELD: opening file: ',dataFName(1:pIL+13)  
              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                        SQUEEZE_RIGHT , myThid)  
             ENDIF  
             length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )  
             OPEN( dUnit, file=dataFName, status='old',  
      &            access='direct', recl=length_of_rec )  
             fileIsOpen=.TRUE.  
            ELSE  
             fileIsOpen=.FALSE.  
             WRITE(msgBuf,'(4A)') ' MDS_READ_FIELD: filename: ',  
      &             fName(1:IL),' , ', dataFName(1:pIL+13)  
             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                          SQUEEZE_RIGHT , myThid)  
             CALL PRINT_ERROR( msgBuf, myThid )  
             WRITE(msgBuf,'(A)')  
      &      ' MDS_READ_FIELD: Files DO not exist'  
             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                          SQUEEZE_RIGHT , myThid)  
             CALL PRINT_ERROR( msgBuf, myThid )  
             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'  
            ENDIF  
           ENDIF  
319    
320            IF (fileIsOpen) THEN            IF (globalFile) THEN
321    C--- Case of 1 Global file:
322    
323    c         IF (fileIsOpen) THEN
324             tNx = sNx             tNx = sNx
325             tNy = sNy             tNy = sNy
326             global_nTx = xSize/sNx             global_nTx = xSize/sNx
# Line 383  C-           default (face fit into glob Line 353  C-           default (face fit into glob
353  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
354             DO k=kLo,kHi             DO k=kLo,kHi
355              DO j=1,tNy              DO j=1,tNy
356               IF (globalFile) THEN               irec = 1 + ( tBx + (j-1)*iGjLoc )/sNx
357                irec = 1 + ( tBx + (j-1)*iGjLoc )/sNx       &                + ( tBy + (j-1)*jGjLoc )*global_nTx
358       &                 + ( tBy + (j-1)*jGjLoc )*global_nTx       &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
      &             +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize  
              ELSE  
               irec = j + ( k-kLo + (irecord-1)*nNz )*sNy  
              ENDIF  
359               IF (filePrec .EQ. precFloat32) THEN               IF (filePrec .EQ. precFloat32) THEN
360                READ(dUnit,rec=irec) r4seg                READ(dUnit,rec=irec) r4seg
361  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
# Line 430  C End of j loop Line 396  C End of j loop
396              ENDDO              ENDDO
397  C End of k loop  C End of k loop
398             ENDDO             ENDDO
399    
400  C end if fileIsOpen  C end if fileIsOpen
401            ENDIF  c         ENDIF
402            IF (fileIsOpen .AND. (.NOT. globalFile)) THEN  
403              ELSE
404    C--- Case of 1 file per tile (globalFile=F):
405    
406    C If we are reading from a tiled MDS file then we open each one here
407               iG=bi+(myXGlobalLo-1)/sNx
408               jG=bj+(myYGlobalLo-1)/sNy
409               WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
410         &            pfName(1:pIL),'.',iG,'.',jG,'.data'
411               INQUIRE( file=dataFName, exist=exst )
412    C Of course, we only open the file if the tile is "active"
413    C (This is a place-holder for the active/passive mechanism
414               IF (exst) THEN
415                IF ( debugLevel .GE. debLevA ) THEN
416                 WRITE(msgBuf,'(A,A)')
417         &       ' MDS_READ_FIELD: opening file: ',dataFName(1:pIL+13)
418                 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
419         &                        SQUEEZE_RIGHT , myThid)
420                ENDIF
421                length_of_rec = MDS_RECLEN( filePrec, sNx*sNy, myThid )
422                OPEN( dUnit, file=dataFName, status='old',
423         &            access='direct', recl=length_of_rec )
424                fileIsOpen=.TRUE.
425               ELSE
426                fileIsOpen=.FALSE.
427                WRITE(msgBuf,'(4A)') ' MDS_READ_FIELD: filename: ',
428         &             fName(1:IL),' , ', dataFName(1:pIL+13)
429                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
430         &                          SQUEEZE_RIGHT , myThid)
431                CALL PRINT_ERROR( msgBuf, myThid )
432                WRITE(msgBuf,'(A)')
433         &      ' MDS_READ_FIELD: Files DO not exist'
434                CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
435         &                          SQUEEZE_RIGHT , myThid)
436                CALL PRINT_ERROR( msgBuf, myThid )
437                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
438               ENDIF
439    
440               DO k=kLo,kHi
441    
442                 irec = 1 + k-kLo + (irecord-1)*nNz
443                 IF (filePrec .EQ. precFloat32) THEN
444                  READ(dUnit,rec=irec) r4loc
445    #ifdef _BYTESWAPIO
446                  CALL MDS_BYTESWAPR4( sNx*sNy, r4loc )
447    #endif
448                  IF ( arrType.EQ.'RS' ) THEN
449                   CALL MDS_PASS_R4toRS( r4loc, arr,
450         I                           k, kSize, bi,bj, .TRUE., myThid )
451                  ELSEIF ( arrType.EQ.'RL' ) THEN
452                   CALL MDS_PASS_R4toRL( r4loc, arr,
453         I                           k, kSize, bi,bj, .TRUE., myThid )
454                  ELSE
455                   WRITE(msgBuf,'(A)')
456         &         ' MDS_READ_FIELD: illegal value for arrType'
457                   CALL PRINT_ERROR( msgBuf, myThid )
458                   STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
459                  ENDIF
460                 ELSEIF (filePrec .EQ. precFloat64) THEN
461                  READ(dUnit,rec=irec) r8loc
462    #ifdef _BYTESWAPIO
463                  CALL MDS_BYTESWAPR8( sNx*sNy, r8loc )
464    #endif
465                  IF ( arrType.EQ.'RS' ) THEN
466                   CALL MDS_PASS_R8toRS( r8loc, arr,
467         I                           k, kSize, bi,bj, .TRUE., myThid )
468                  ELSEIF ( arrType.EQ.'RL' ) THEN
469                   CALL MDS_PASS_R8toRL( r8loc, arr,
470         I                           k, kSize, bi,bj, .TRUE., myThid )
471                  ELSE
472                   WRITE(msgBuf,'(A)')
473         &         ' MDS_READ_FIELD: illegal value for arrType'
474                   CALL PRINT_ERROR( msgBuf, myThid )
475                   STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
476                  ENDIF
477                 ELSE
478                  WRITE(msgBuf,'(A)')
479         &        ' MDS_READ_FIELD: illegal value for filePrec'
480                  CALL PRINT_ERROR( msgBuf, myThid )
481                  STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
482                 ENDIF
483    
484    C End of k loop
485               ENDDO
486    
487    C here We close the tiled MDS file
488               IF ( fileIsOpen ) THEN
489              CLOSE( dUnit )              CLOSE( dUnit )
490              fileIsOpen = .FALSE.              fileIsOpen = .FALSE.
491               ENDIF
492    
493    C--- End Global File / tile-file cases
494            ENDIF            ENDIF
495    
496  C End of bi,bj loops  C End of bi,bj loops
497           ENDDO           ENDDO
498          ENDDO          ENDDO
Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22