/[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.5 by jmc, Wed May 6 02:42:49 2009 UTC revision 1.11 by jmc, Mon Jun 8 14:38:54 2009 UTC
# Line 59  C Global variables / common blocks Line 59  C Global variables / common blocks
59  #include "EEPARAMS.h"  #include "EEPARAMS.h"
60  #include "PARAMS.h"  #include "PARAMS.h"
61  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
62    #include "W2_EXCH2_SIZE.h"
63  #include "W2_EXCH2_TOPOLOGY.h"  #include "W2_EXCH2_TOPOLOGY.h"
64  #include "W2_EXCH2_PARAMS.h"  #include "W2_EXCH2_PARAMS.h"
65  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
66  #include "MDSIO_SCPU.h"  #include "EEBUFF_SCPU.h"
67    #ifdef ALLOW_FIZHI
68    # include "fizhi_SIZE.h"
69    #endif /* ALLOW_FIZHI */
70    #include "MDSIO_BUFF_3D.h"
71    
72  C !INPUT PARAMETERS:  C !INPUT PARAMETERS:
73        CHARACTER*(*) fName        CHARACTER*(*) fName
# Line 84  C !FUNCTIONS Line 89  C !FUNCTIONS
89        EXTERNAL MASTER_CPU_IO        EXTERNAL MASTER_CPU_IO
90    
91  C !LOCAL VARIABLES:  C !LOCAL VARIABLES:
92    C     bBij  :: base shift in Buffer index for tile bi,bj
93        CHARACTER*(MAX_LEN_FNAM) dataFName,pfName        CHARACTER*(MAX_LEN_FNAM) dataFName,pfName
94        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
95        LOGICAL exst        LOGICAL exst
96        LOGICAL globalFile, fileIsOpen        LOGICAL globalFile, fileIsOpen
97        LOGICAL iAmDoingIO        LOGICAL iAmDoingIO
98          LOGICAL useExch2ioLayOut
99        INTEGER xSize, ySize        INTEGER xSize, ySize
100        INTEGER iG,jG,bi,bj,i,j,k,nNz        INTEGER iG,jG,bi,bj
101          INTEGER i1,i2,i,j,k,nNz
102        INTEGER irec,dUnit,IL,pIL        INTEGER irec,dUnit,IL,pIL
103        INTEGER length_of_rec        INTEGER length_of_rec
104        Real*4 r4seg(sNx)        INTEGER bBij
105        Real*8 r8seg(sNx)        INTEGER tNx, tNy, global_nTx
106          INTEGER tBx, tBy, iGjLoc, jGjLoc
107  #ifdef ALLOW_EXCH2  #ifdef ALLOW_EXCH2
108        INTEGER iGjLoc, jGjLoc        INTEGER tN
 c     INTEGER tGy,tGx,tNy,tNx,tN  
       INTEGER tGy,tGx,    tNx,tN  
       INTEGER global_nTx  
109  #endif /* ALLOW_EXCH2 */  #endif /* ALLOW_EXCH2 */
       INTEGER tNy  
110    
111  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
112  C Set dimensions:  C Set dimensions:
113        xSize = Nx        xSize = Nx
114        ySize = Ny        ySize = Ny
115  #if defined(ALLOW_EXCH2) && !defined(MISSING_TILE_IO)        useExch2ioLayOut = .FALSE.
116        xSize = exch2_global_Nx  #ifdef ALLOW_EXCH2
117        ySize = exch2_global_Ny        IF ( W2_useE2ioLayOut ) THEN
118  #endif          xSize = exch2_global_Nx
119            ySize = exch2_global_Ny
120            useExch2ioLayOut = .TRUE.
121          ENDIF
122    #endif /* ALLOW_EXCH2 */
123    
124  C Assume nothing  C Assume nothing
125        globalFile = .FALSE.        globalFile = .FALSE.
# Line 122  C Assume nothing Line 131  C Assume nothing
131  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):
132        iAmDoingIO = MASTER_CPU_IO(myThid)        iAmDoingIO = MASTER_CPU_IO(myThid)
133    
 C Only do I/O if I am the master thread  
       IF ( iAmDoingIO ) THEN  
   
134  C Record number must be >= 1  C Record number must be >= 1
135          IF (irecord .LT. 1) THEN        IF (irecord .LT. 1) THEN
136           WRITE(msgBuf,'(A,I9.8)')          WRITE(msgBuf,'(3A,I10))')
137       &     ' MDS_READ_FIELD: argument irecord = ',irecord       &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
138           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
139       &                       SQUEEZE_RIGHT , myThid)       &                      SQUEEZE_RIGHT , myThid )
140           WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A,I9.8)')
141       &     ' MDS_READ_FIELD: Invalid value for irecord'       &    ' MDS_READ_FIELD: argument irecord = ',irecord
142           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
143           STOP 'ABNORMAL END: S/R MDS_READ_FIELD'       &                      SQUEEZE_RIGHT , myThid )
144          ENDIF          WRITE(msgBuf,'(A)')
145         &    ' MDS_READ_FIELD: Invalid value for irecord'
146            CALL PRINT_ERROR( msgBuf, myThid )
147            CALL ALL_PROC_DIE( myThid )
148            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
149          ENDIF
150  C check for valid sub-set of levels:  C check for valid sub-set of levels:
151          IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN        IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
152           WRITE(msgBuf,'(3(A,I6))')          WRITE(msgBuf,'(3A,I10))')
153       &     ' MDS_READ_FIELD: arguments kSize=', kSize,       &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
154       &     ' , kLo=', kLo, ' , kHi=', kHi          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
155           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,       &                      SQUEEZE_RIGHT , myThid )
156       &                       SQUEEZE_RIGHT , myThid)          WRITE(msgBuf,'(3(A,I6))')
157           WRITE(msgBuf,'(A)')       &    ' MDS_READ_FIELD: arguments kSize=', kSize,
158       &     ' MDS_READ_FIELD: invalid sub-set of levels'       &    ' , kLo=', kLo, ' , kHi=', kHi
159           CALL PRINT_ERROR( msgBuf, myThid )          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
160           STOP 'ABNORMAL END: S/R MDS_READ_FIELD'       &                      SQUEEZE_RIGHT , myThid )
161          ENDIF          WRITE(msgBuf,'(A)')
162         &    ' MDS_READ_FIELD: invalid sub-set of levels'
163            CALL PRINT_ERROR( msgBuf, myThid )
164            CALL ALL_PROC_DIE( myThid )
165            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
166          ENDIF
167    C check for 3-D Buffer size:
168          IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
169            WRITE(msgBuf,'(3A,I10))')
170         &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
171            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
172         &                      SQUEEZE_RIGHT , myThid )
173            WRITE(msgBuf,'(3(A,I6))')
174         &    ' MDS_READ_FIELD: Nb Lev to read =', nNz,
175         &    ' >', size3dBuf, ' = buffer 3rd Dim'
176            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
177         &                      SQUEEZE_RIGHT , myThid )
178            WRITE(msgBuf,'(A)')
179         &    ' MDS_READ_FIELD: buffer 3rd Dim. too small'
180            CALL PRINT_ERROR( msgBuf, myThid )
181            WRITE(msgBuf,'(A)')
182         &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
183            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
184         &                      SQUEEZE_RIGHT , myThid )
185            CALL ALL_PROC_DIE( myThid )
186            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
187          ENDIF
188    
189    C Only do I/O if I am the master thread
190          IF ( iAmDoingIO ) THEN
191    
192  C Assign special directory  C Assign special directory
193          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN          IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
# Line 204  C master thread of process 0, only, open Line 244  C master thread of process 0, only, open
244  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.
245  C Otherwise stop program.  C Otherwise stop program.
246           IF ( globalFile) THEN           IF ( globalFile) THEN
247            length_of_rec=MDS_RECLEN( filePrec, xSize*ySize, myThid )            length_of_rec = MDS_RECLEN( filePrec, xSize*ySize, myThid )
248            OPEN( dUnit, file=dataFName, status='old',            OPEN( dUnit, file=dataFName, status='old',
249       &         access='direct', recl=length_of_rec )       &         access='direct', recl=length_of_rec )
250           ELSE           ELSE
# Line 227  C- endif iAmDoingIO Line 267  C- endif iAmDoingIO
267    
268  C master thread of process 0, only, read from file  C master thread of process 0, only, read from file
269          IF ( iAmDoingIO ) THEN          IF ( iAmDoingIO ) THEN
270            irec = k+1-kLo+nNz*(irecord-1)            irec = 1 + k-kLo + (irecord-1)*nNz
271            IF (filePrec .EQ. precFloat32) THEN            IF (filePrec .EQ. precFloat32) THEN
272             READ(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )             READ(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
273  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
274             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )             CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
275  #endif  #endif
276            ELSEIF (filePrec .EQ. precFloat64) THEN            ELSE
277             READ(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )             READ(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
278  #ifdef _BYTESWAPIO  #ifdef _BYTESWAPIO
279             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )             CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
280  #endif  #endif
           ELSE  
            WRITE(msgBuf,'(A)')  
      &            ' MDS_READ_FIELD: illegal value for filePrec'  
            CALL PRINT_ERROR( msgBuf, myThid )  
            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'  
281            ENDIF            ENDIF
 C Map the appropriate global io-buffer to global model (real*8) array  
           CALL MDS_MAP_GLOBAL(  
      U                 xy_buffer_r4, xy_buffer_r8,  
      U                 globalBuf,  
      I                 xSize, ySize, filePrec,  
      I                 .TRUE., .FALSE. )  
282  C- endif iAmDoingIO  C- endif iAmDoingIO
283          ENDIF          ENDIF
284          CALL SCATTER_2D(globalBuf,sharedLocalBuf,myThid)  
285          IF (arrType .EQ. 'RS') THEN  C Wait for all thread to finish. This prevents other threads to continue
286            CALL MDS_PASStoRS( sharedLocalBuf,arr,k,kSize,.TRUE.,myThid )  C  to acces shared buffer while master thread is loading data into
287          ELSEIF (arrType .EQ. 'RL') THEN          CALL BAR2( myThid )
288            CALL MDS_PASStoRL( sharedLocalBuf,arr,k,kSize,.TRUE.,myThid )  
289            IF ( filePrec.EQ.precFloat32 ) THEN
290              CALL SCATTER_2D_R4(
291         U                        xy_buffer_r4,
292         O                        sharedLocBuf_r4,
293         I                        xSize, ySize,
294         I                        useExch2ioLayOut, .FALSE., myThid )
295    C All threads wait for Master to finish loading into shared buffer
296              CALL BAR2( myThid )
297              IF ( arrType.EQ.'RS' ) THEN
298                CALL MDS_PASS_R4toRS( sharedLocBuf_r4, arr,
299         I                        1, k, kSize, 0, 0, .TRUE., myThid )
300              ELSEIF ( arrType.EQ.'RL' ) THEN
301                CALL MDS_PASS_R4toRL( sharedLocBuf_r4, arr,
302         I                        1, k, kSize, 0, 0, .TRUE., myThid )
303              ELSE
304                WRITE(msgBuf,'(A)')
305         &          ' MDS_READ_FIELD: illegal value for arrType'
306                CALL PRINT_ERROR( msgBuf, myThid )
307                CALL ALL_PROC_DIE( myThid )
308                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
309              ENDIF
310            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
311              CALL SCATTER_2D_R8(
312         U                        xy_buffer_r8,
313         O                        sharedLocBuf_r8,
314         I                        xSize, ySize,
315         I                        useExch2ioLayOut, .FALSE., myThid )
316    C All threads wait for Master to finish loading into shared buffer
317              CALL BAR2( myThid )
318              IF ( arrType.EQ.'RS' ) THEN
319                CALL MDS_PASS_R8toRS( sharedLocBuf_r8, arr,
320         I                        1, k, kSize, 0, 0, .TRUE., myThid )
321              ELSEIF ( arrType.EQ.'RL' ) THEN
322                CALL MDS_PASS_R8toRL( sharedLocBuf_r8, arr,
323         I                        1, k, kSize, 0, 0, .TRUE., myThid )
324              ELSE
325                WRITE(msgBuf,'(A)')
326         &          ' MDS_READ_FIELD: illegal value for arrType'
327                CALL PRINT_ERROR( msgBuf, myThid )
328                CALL ALL_PROC_DIE( myThid )
329                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
330              ENDIF
331          ELSE          ELSE
332            WRITE(msgBuf,'(A)')            WRITE(msgBuf,'(A)')
333       &          ' MDS_READ_FIELD: illegal value for arrType'       &            ' MDS_READ_FIELD: illegal value for filePrec'
334            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
335              CALL ALL_PROC_DIE( myThid )
336            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'            STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
337          ENDIF          ENDIF
338    
# Line 275  C---+----1----+----2----+----3----+----4 Line 347  C---+----1----+----2----+----3----+----4
347  C---  else .NOT.useSingleCpuIO  C---  else .NOT.useSingleCpuIO
348        ELSE        ELSE
349    
350    C Wait for all thread to finish. This prevents other threads to continue
351    C  to acces 3-D buffer while master thread is reading
352           CALL BAR2( myThid )
353    
354  C Only do I/O if I am the master thread  C Only do I/O if I am the master thread
355         IF ( iAmDoingIO ) THEN         IF ( iAmDoingIO ) THEN
356    
357  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
358          IF (globalFile) THEN          IF (globalFile) THEN
359           length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
360           OPEN( dUnit, file=dataFName, status='old',           OPEN( dUnit, file=dataFName, status='old',
361       &        access='direct', recl=length_of_rec )       &        access='direct', recl=length_of_rec )
362           fileIsOpen=.TRUE.           fileIsOpen=.TRUE.
# Line 289  C If we are reading from a global file t Line 365  C If we are reading from a global file t
365  C Loop over all tiles  C Loop over all tiles
366          DO bj=1,nSy          DO bj=1,nSy
367           DO bi=1,nSx           DO bi=1,nSx
368              bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
369    
370              IF (globalFile) THEN
371    C--- Case of 1 Global file:
372    
373    c         IF (fileIsOpen) THEN
374               tNx = sNx
375               tNy = sNy
376               global_nTx = xSize/sNx
377               tBx = myXGlobalLo-1 + (bi-1)*sNx
378               tBy = myYGlobalLo-1 + (bj-1)*sNy
379               iGjLoc = 0
380               jGjLoc = 1
381    #ifdef ALLOW_EXCH2
382               IF ( useExch2ioLayOut ) THEN
383                 tN = W2_myTileList(bi)
384    c            tNx = exch2_tNx(tN)
385    c            tNy = exch2_tNy(tN)
386    c            global_nTx = exch2_global_Nx/tNx
387                 tBx = exch2_txGlobalo(tN) - 1
388                 tBy = exch2_tyGlobalo(tN) - 1
389                 IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
390    C-           face x-size larger than glob-size : fold it
391                   iGjLoc = 0
392                   jGjLoc = exch2_mydNx(tN) / xSize
393                 ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
394    C-           tile y-size larger than glob-size : make a long line
395                   iGjLoc = exch2_mydNx(tN)
396                   jGjLoc = 0
397                 ELSE
398    C-           default (face fit into global-IO-array)
399                   iGjLoc = 0
400                   jGjLoc = 1
401                 ENDIF
402               ENDIF
403    #endif /* ALLOW_EXCH2 */
404    
405               DO k=kLo,kHi
406                DO j=1,tNy
407                 irec = 1 + ( tBx + (j-1)*iGjLoc )/sNx
408         &                + ( tBy + (j-1)*jGjLoc )*global_nTx
409         &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
410                 i1 = bBij + 1 + (j-1)*sNx + (k-kLo)*sNx*sNy
411                 i2 = bBij +         j*sNx + (k-kLo)*sNx*sNy
412                 IF ( filePrec.EQ.precFloat32 ) THEN
413                  READ(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
414                 ELSE
415                  READ(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
416                 ENDIF
417    C End of j,k loops
418                ENDDO
419               ENDDO
420    
421    C end if fileIsOpen
422    c         ENDIF
423    
424              ELSE
425    C--- Case of 1 file per tile (globalFile=F):
426    
427  C If we are reading from a tiled MDS file then we open each one here  C If we are reading from a tiled MDS file then we open each one here
428            IF (.NOT. globalFile) THEN             iG=bi+(myXGlobalLo-1)/sNx
429             iG=bi+(myXGlobalLo-1)/sNx ! Kludge until unstructered tiles             jG=bj+(myYGlobalLo-1)/sNy
            jG=bj+(myYGlobalLo-1)/sNy ! Kludge until unstructered tiles  
430             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')             WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
431       &            pfName(1:pIL),'.',iG,'.',jG,'.data'       &            pfName(1:pIL),'.',iG,'.',jG,'.data'
432             INQUIRE( file=dataFName, exist=exst )             INQUIRE( file=dataFName, exist=exst )
# Line 305  C (This is a place-holder for the active Line 439  C (This is a place-holder for the active
439               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,               CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
440       &                        SQUEEZE_RIGHT , myThid)       &                        SQUEEZE_RIGHT , myThid)
441              ENDIF              ENDIF
442              length_of_rec=MDS_RECLEN( filePrec, sNx, myThid )              length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
443              OPEN( dUnit, file=dataFName, status='old',              OPEN( dUnit, file=dataFName, status='old',
444       &            access='direct', recl=length_of_rec )       &            access='direct', recl=length_of_rec )
445              fileIsOpen=.TRUE.              fileIsOpen=.TRUE.
# Line 323  C (This is a place-holder for the active Line 457  C (This is a place-holder for the active
457              CALL PRINT_ERROR( msgBuf, myThid )              CALL PRINT_ERROR( msgBuf, myThid )
458              STOP 'ABNORMAL END: S/R MDS_READ_FIELD'              STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
459             ENDIF             ENDIF
           ENDIF  
460    
461            IF (fileIsOpen) THEN             irec = irecord
462             tNy = sNy             i1 = bBij + 1
463  #ifdef ALLOW_EXCH2             i2 = bBij + sNx*sNy*nNz
464             tN = W2_myTileList(bi)             IF ( filePrec.EQ.precFloat32 ) THEN
465             tGy = exch2_tyGlobalo(tN)               READ(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
            tGx = exch2_txGlobalo(tN)  
            tNy = exch2_tNy(tN)  
            tNx = exch2_tNx(tN)  
            IF   ( exch2_mydNx(tN) .GT. xSize ) THEN  
 C-         face x-size larger than glob-size : fold it  
              iGjLoc = 0  
              jGjLoc = exch2_mydNx(tN) / xSize  
            ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN  
 C-         tile y-size larger than glob-size : make a long line  
              iGjLoc = exch2_mydNx(tN)  
              jGjLoc = 0  
466             ELSE             ELSE
467  C-         default (face fit into global-IO-array)               READ(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
              iGjLoc = 0  
              jGjLoc = 1  
468             ENDIF             ENDIF
469             global_nTx = exch2_global_Nx/tNx  
470  #endif /* ALLOW_EXCH2 */  C here We close the tiled MDS file
471             DO k=kLo,kHi             IF ( fileIsOpen ) THEN
472              DO j=1,tNy               CLOSE( dUnit )
473               IF (globalFile) THEN               fileIsOpen = .FALSE.
474  #ifdef ALLOW_EXCH2             ENDIF
475                irec = 1 + ( tGx-1 + (j-1)*iGjLoc )/tNx  
476       &                 + ( tGy-1 + (j-1)*jGjLoc )*global_nTx  C--- End Global File / tile-file cases
      &                 + ( k-kLo + (irecord-1)*nNz  
      &                   )*ySize*global_nTx  
 #else /* ALLOW_EXCH2 */  
               iG = myXGlobalLo-1 + (bi-1)*sNx  
               jG = myYGlobalLo-1 + (bj-1)*sNy  
               irec= 1 + INT(iG/sNx) + nSx*nPx*(jG+j-1)  
      &                + nSx*nPx*Ny*(k-kLo)  
      &                + nSx*nPx*Ny*nNz*(irecord-1)  
 #endif /* ALLOW_EXCH2 */  
              ELSE  
               irec=j + sNy*(k-kLo) + sNy*nNz*(irecord-1)  
              ENDIF  
              IF (filePrec .EQ. precFloat32) THEN  
               READ(dUnit,rec=irec) r4seg  
 #ifdef _BYTESWAPIO  
               CALL MDS_BYTESWAPR4( sNx, r4seg )  
 #endif  
               IF (arrType .EQ. 'RS') THEN  
                CALL MDS_SEG4toRS( j,bi,bj,k,kSize, r4seg, .TRUE., arr )  
               ELSEIF (arrType .EQ. 'RL') THEN  
                CALL MDS_SEG4toRL( j,bi,bj,k,kSize, r4seg, .TRUE., arr )  
               ELSE  
                WRITE(msgBuf,'(A)')  
      &         ' MDS_READ_FIELD: illegal value for arrType'  
                CALL PRINT_ERROR( msgBuf, myThid )  
                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'  
               ENDIF  
              ELSEIF (filePrec .EQ. precFloat64) THEN  
               READ(dUnit,rec=irec) r8seg  
 #ifdef _BYTESWAPIO  
               CALL MDS_BYTESWAPR8( sNx, r8seg )  
 #endif  
               IF (arrType .EQ. 'RS') THEN  
                CALL MDS_SEG8toRS( j,bi,bj,k,kSize, r8seg, .TRUE., arr )  
               ELSEIF (arrType .EQ. 'RL') THEN  
                CALL MDS_SEG8toRL( j,bi,bj,k,kSize, r8seg, .TRUE., arr )  
               ELSE  
                WRITE(msgBuf,'(A)')  
      &         ' MDS_READ_FIELD: illegal value for arrType'  
                CALL PRINT_ERROR( msgBuf, myThid )  
                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'  
               ENDIF  
              ELSE  
               WRITE(msgBuf,'(A)')  
      &        ' MDS_READ_FIELD: illegal value for filePrec'  
               CALL PRINT_ERROR( msgBuf, myThid )  
               STOP 'ABNORMAL END: S/R MDS_READ_FIELD'  
              ENDIF  
 C End of j loop  
             ENDDO  
 C End of k loop  
            ENDDO  
 C end if fileIsOpen  
           ENDIF  
           IF (fileIsOpen .AND. (.NOT. globalFile)) THEN  
             CLOSE( dUnit )  
             fileIsOpen = .FALSE.  
477            ENDIF            ENDIF
478    
479  C End of bi,bj loops  C End of bi,bj loops
480           ENDDO           ENDDO
481          ENDDO          ENDDO
482    
483  C If global file was opened then close it  C If global file was opened then close it
484          IF (fileIsOpen .AND. globalFile) THEN          IF (fileIsOpen .AND. globalFile) THEN
485           CLOSE( dUnit )            CLOSE( dUnit )
486           fileIsOpen = .FALSE.            fileIsOpen = .FALSE.
487          ENDIF          ENDIF
488    
489    #ifdef _BYTESWAPIO
490            IF ( filePrec.EQ.precFloat32 ) THEN
491              CALL MDS_BYTESWAPR4( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r4 )
492            ELSE
493              CALL MDS_BYTESWAPR8( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r8 )
494            ENDIF
495    #endif
496    
497  C- endif iAmDoingIO  C- endif iAmDoingIO
498         ENDIF         ENDIF
499    
500    C All threads wait for Master to finish reading into shared buffer
501           CALL BAR2( myThid )
502    
503    C---    Copy from 3-D buffer to arr (multi-threads):
504            IF ( filePrec.EQ.precFloat32 ) THEN
505              IF ( arrType.EQ.'RS' ) THEN
506                CALL MDS_PASS_R4toRS( shared3dBuf_r4, arr,
507         I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )
508              ELSEIF ( arrType.EQ.'RL' ) THEN
509                CALL MDS_PASS_R4toRL( shared3dBuf_r4, arr,
510         I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )
511              ELSE
512                WRITE(msgBuf,'(A)')
513         &         ' MDS_READ_FIELD: illegal value for arrType'
514                CALL PRINT_ERROR( msgBuf, myThid )
515                CALL ALL_PROC_DIE( myThid )
516                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
517              ENDIF
518            ELSEIF ( filePrec.EQ.precFloat64 ) THEN
519              IF ( arrType.EQ.'RS' ) THEN
520                CALL MDS_PASS_R8toRS( shared3dBuf_r8, arr,
521         I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )
522              ELSEIF ( arrType.EQ.'RL' ) THEN
523                CALL MDS_PASS_R8toRL( shared3dBuf_r8, arr,
524         I                    nNz, kLo, kSize, 0, 0, .TRUE., myThid )
525              ELSE
526                WRITE(msgBuf,'(A)')
527         &         ' MDS_READ_FIELD: illegal value for arrType'
528                CALL PRINT_ERROR( msgBuf, myThid )
529                CALL ALL_PROC_DIE( myThid )
530                STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
531              ENDIF
532            ELSE
533              WRITE(msgBuf,'(A)')
534         &         ' MDS_READ_FIELD: illegal value for filePrec'
535              CALL PRINT_ERROR( msgBuf, myThid )
536              CALL ALL_PROC_DIE( myThid )
537              STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
538            ENDIF
539    
540  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
541  C     if useSingleCpuIO / else / end  C     if useSingleCpuIO / else / end
542        ENDIF        ENDIF
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22