Back to home page

MITgcm
 
 

    

File indexing completed on 2022-04-14 05:09:28 UTC

view on githubraw file Latest commit 3d93c0a0 on 2022-04-13 15:21:38 UTC
37f13932c5 Jean*0001 #include "MDSIO_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C !ROUTINE: MDS_READ_FIELD
                0005 C !INTERFACE:
                0006       SUBROUTINE MDS_READ_FIELD(
                0007      I   fName,
                0008      I   filePrec,
                0009      I   useCurrentDir,
                0010      I   arrType,
c0c8c1b5a1 Jean*0011      I   kSize,kLo,kHi,
608f4af3c8 Jean*0012      O   fldRL, fldRS,
37f13932c5 Jean*0013      I   irecord,
                0014      I   myThid )
                0015 
                0016 C !DESCRIPTION:
                0017 C Arguments:
                0018 C
                0019 C fName     (string)  :: base name for file to read
                0020 C filePrec  (integer) :: number of bits per word in file (32 or 64)
                0021 C useCurrentDir(logic):: always read from the current directory (even if
                0022 C                        "mdsioLocalDir" is set)
608f4af3c8 Jean*0023 C arrType   (char(2)) :: which array (fldRL/RS) to read into, either "RL" or "RS"
c0c8c1b5a1 Jean*0024 C kSize     (integer) :: size of third dimension: normally either 1 or Nr
608f4af3c8 Jean*0025 C kLo       (integer) :: 1rst vertical level (of array fldRL/RS) to read-in
                0026 C kHi       (integer) :: last vertical level (of array fldRL/RS) to read-in
                0027 C fldRL       ( RL )  :: array to read into if arrType="RL", fldRL(:,:,kSize,:,:)
                0028 C fldRS       ( RS )  :: array to read into if arrType="RS", fldRS(:,:,kSize,:,:)
37f13932c5 Jean*0029 C irecord   (integer) :: record number to read
                0030 C myIter    (integer) :: time step number
                0031 C myThid    (integer) :: thread identifier
                0032 C
                0033 C MDS_READ_FIELD first checks to see IF the file "fName" exists, then
c0c8c1b5a1 Jean*0034 C  IF the file "fName.data" exists and finally the tiled files of the
                0035 C  form "fName.xxx.yyy.data" exist. Currently, the meta-files are not
                0036 C  read because it is difficult to parse files in fortran.
37f13932c5 Jean*0037 C The precision of the file is decsribed by filePrec, set either
608f4af3c8 Jean*0038 C  to floatPrec32 or floatPrec64. The char*(2) string arrType, either "RL"
                0039 C  or "RS", selects which array is filled in, either fldRL or fldRS.
c0c8c1b5a1 Jean*0040 C (kSize,kLo,kHi) allows for both 2-D and 3-D arrays to be handled, with
                0041 C  the option to only read and fill-in a sub-set of consecutive vertical
                0042 C  levels (from kLo to kHi) ; (kSize,kLo,kHi)=(1,1,1) implies a 2-D model
                0043 C  field and (kSize,kLo,kHi)=(Nr,1,Nr) implies a 3-D model field.
                0044 C irecord is the record number to be read and must be >= 1.
608f4af3c8 Jean*0045 C The file data is stored in fldRL/RS *but* the overlaps are *not* updated,
2186fe42a7 Jean*0046 C  i.e., an exchange must be called.
                0047 C
                0048 C- Multi-threaded: Only Master thread does IO (and MPI calls) and put data
                0049 C   to a shared buffer that any thread can get access to.
                0050 C- Convention regarding thread synchronisation (BARRIER):
                0051 C  A per-thread (or per tile) partition of the 2-D shared-buffer (sharedLocBuf_r4/r8)
                0052 C   is readily available => any access (e.g., by master-thread) to a portion
                0053 C   owned by an other thread is put between BARRIER (protected).
                0054 C  No thread partition exist for the 3-D shared buffer (shared3dBuf_r4/r8).
                0055 C   Therefore, the 3-D buffer is considered to be owned by master-thread and
                0056 C   any access by other than master thread is put between BARRIER (protected).
37f13932c5 Jean*0057 C
                0058 C Created: 03/16/99 adcroft@mit.edu
                0059 CEOP
                0060 
                0061 C !USES:
                0062       IMPLICIT NONE
                0063 C Global variables / common blocks
                0064 #include "SIZE.h"
                0065 #include "EEPARAMS.h"
                0066 #include "PARAMS.h"
                0067 #ifdef ALLOW_EXCH2
f9f661930b Jean*0068 #include "W2_EXCH2_SIZE.h"
37f13932c5 Jean*0069 #include "W2_EXCH2_TOPOLOGY.h"
f7508ac42d Jean*0070 #include "W2_EXCH2_PARAMS.h"
37f13932c5 Jean*0071 #endif /* ALLOW_EXCH2 */
f7508ac42d Jean*0072 #include "EEBUFF_SCPU.h"
d24daa2c55 Jean*0073 #ifdef ALLOW_FIZHI
                0074 # include "fizhi_SIZE.h"
                0075 #endif /* ALLOW_FIZHI */
8decba0243 Jean*0076 #include "MDSIO_BUFF_3D.h"
37f13932c5 Jean*0077 
                0078 C !INPUT PARAMETERS:
                0079       CHARACTER*(*) fName
                0080       INTEGER filePrec
                0081       LOGICAL useCurrentDir
                0082       CHARACTER*(2) arrType
c0c8c1b5a1 Jean*0083       INTEGER kSize, kLo, kHi
37f13932c5 Jean*0084       INTEGER irecord
                0085       INTEGER myThid
                0086 C !OUTPUT PARAMETERS:
608f4af3c8 Jean*0087       _RL  fldRL(*)
                0088       _RS  fldRS(*)
37f13932c5 Jean*0089 
                0090 C !FUNCTIONS
                0091       INTEGER  ILNBLNK
                0092       INTEGER  MDS_RECLEN
                0093       LOGICAL  MASTER_CPU_IO
                0094       EXTERNAL ILNBLNK
                0095       EXTERNAL MDS_RECLEN
                0096       EXTERNAL MASTER_CPU_IO
                0097 
                0098 C !LOCAL VARIABLES:
8decba0243 Jean*0099 C     bBij  :: base shift in Buffer index for tile bi,bj
37f13932c5 Jean*0100       CHARACTER*(MAX_LEN_FNAM) dataFName,pfName
                0101       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0102       LOGICAL exst
                0103       LOGICAL globalFile, fileIsOpen
                0104       LOGICAL iAmDoingIO
f7508ac42d Jean*0105       LOGICAL useExch2ioLayOut
e039218b63 Jean*0106       INTEGER xSize, ySize
8decba0243 Jean*0107       INTEGER iG,jG,bi,bj
                0108       INTEGER i1,i2,i,j,k,nNz
c0c8c1b5a1 Jean*0109       INTEGER irec,dUnit,IL,pIL
e546f6387c Oliv*0110       INTEGER length_of_rec
8decba0243 Jean*0111       INTEGER bBij
f7508ac42d Jean*0112       INTEGER tNx, tNy, global_nTx
                0113       INTEGER tBx, tBy, iGjLoc, jGjLoc
37f13932c5 Jean*0114 #ifdef ALLOW_EXCH2
f7508ac42d Jean*0115       INTEGER tN
37f13932c5 Jean*0116 #endif /* ALLOW_EXCH2 */
                0117 
                0118 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
e039218b63 Jean*0119 C Set dimensions:
                0120       xSize = Nx
                0121       ySize = Ny
f7508ac42d Jean*0122       useExch2ioLayOut = .FALSE.
                0123 #ifdef ALLOW_EXCH2
                0124       IF ( W2_useE2ioLayOut ) THEN
                0125         xSize = exch2_global_Nx
                0126         ySize = exch2_global_Ny
                0127         useExch2ioLayOut = .TRUE.
                0128       ENDIF
                0129 #endif /* ALLOW_EXCH2 */
37f13932c5 Jean*0130 
                0131 C Assume nothing
                0132       globalFile = .FALSE.
                0133       fileIsOpen = .FALSE.
                0134       IL  = ILNBLNK( fName )
                0135       pIL = ILNBLNK( mdsioLocalDir )
c0c8c1b5a1 Jean*0136       nNz = 1 + kHi - kLo
37f13932c5 Jean*0137 
                0138 C Only do I/O if I am the master thread (and mpi process 0 IF useSingleCpuIO):
                0139       iAmDoingIO = MASTER_CPU_IO(myThid)
                0140 
a0e387243c Jean*0141 C File name should not be too long:
                0142 C    IL(+pIL if not useCurrentDir)(+5: '.data')(+8: bi,bj) =< MAX_LEN_FNAM
                0143 C    and shorter enough to be written to msgBuf with other informations
                0144       IF ( useCurrentDir .AND. (90+IL).GT.MAX_LEN_MBUF ) THEN
                0145         WRITE(msgBuf,'(2A,2(I4,A))') 'MDS_READ_FIELD: ',
                0146      &   'Too long (IL=',IL,') file name:'
                0147         CALL PRINT_ERROR( msgBuf, myThid )
                0148         WRITE(errorMessageUnit,'(3A)')'file: >',fName(1:IL),'<'
                0149         CALL ALL_PROC_DIE( myThid )
                0150         STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0151       ELSEIF ( (90+IL+pIL).GT.MAX_LEN_MBUF ) THEN
                0152         WRITE(msgBuf,'(2A,2(I4,A))') 'MDS_READ_FIELD: ',
                0153      &   'Too long (pIL=',pIL,', IL=',IL,') pfix + file name:'
                0154         CALL PRINT_ERROR( msgBuf, myThid )
                0155         WRITE(errorMessageUnit,'(3A)')'pfix: >',mdsioLocalDir(1:pIL),'<'
                0156         WRITE(errorMessageUnit,'(3A)')'file: >',fName(1:IL),'<'
                0157         CALL ALL_PROC_DIE( myThid )
                0158         STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0159       ENDIF
37f13932c5 Jean*0160 C Record number must be >= 1
8decba0243 Jean*0161       IF (irecord .LT. 1) THEN
e5df3a82bd Jean*0162         WRITE(msgBuf,'(3A,I10)')
d24daa2c55 Jean*0163      &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
                0164         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0165      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0166         WRITE(msgBuf,'(A,I9.8)')
                0167      &    ' MDS_READ_FIELD: argument irecord = ',irecord
                0168         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0169      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0170         WRITE(msgBuf,'(A)')
                0171      &    ' MDS_READ_FIELD: Invalid value for irecord'
                0172         CALL PRINT_ERROR( msgBuf, myThid )
                0173         CALL ALL_PROC_DIE( myThid )
                0174         STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0175       ENDIF
c0c8c1b5a1 Jean*0176 C check for valid sub-set of levels:
8decba0243 Jean*0177       IF ( kLo.LT.1 .OR. kHi.GT.kSize ) THEN
e5df3a82bd Jean*0178         WRITE(msgBuf,'(3A,I10)')
d24daa2c55 Jean*0179      &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
                0180         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0181      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0182         WRITE(msgBuf,'(3(A,I6))')
                0183      &    ' MDS_READ_FIELD: arguments kSize=', kSize,
                0184      &    ' , kLo=', kLo, ' , kHi=', kHi
                0185         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0186      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0187         WRITE(msgBuf,'(A)')
                0188      &    ' MDS_READ_FIELD: invalid sub-set of levels'
                0189         CALL PRINT_ERROR( msgBuf, myThid )
                0190         CALL ALL_PROC_DIE( myThid )
                0191         STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0192       ENDIF
                0193 C check for 3-D Buffer size:
                0194       IF ( .NOT.useSingleCpuIO .AND. nNz.GT.size3dBuf ) THEN
e5df3a82bd Jean*0195         WRITE(msgBuf,'(3A,I10)')
d24daa2c55 Jean*0196      &    ' MDS_READ_FIELD: file="', fName(1:IL), '"'
                0197         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0198      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0199         WRITE(msgBuf,'(3(A,I6))')
                0200      &    ' MDS_READ_FIELD: Nb Lev to read =', nNz,
                0201      &    ' >', size3dBuf, ' = buffer 3rd Dim'
                0202         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0203      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0204         WRITE(msgBuf,'(A)')
                0205      &    ' MDS_READ_FIELD: buffer 3rd Dim. too small'
                0206         CALL PRINT_ERROR( msgBuf, myThid )
                0207         WRITE(msgBuf,'(A)')
                0208      &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
                0209         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
a0e387243c Jean*0210      &                      SQUEEZE_RIGHT, myThid )
8decba0243 Jean*0211         CALL ALL_PROC_DIE( myThid )
                0212         STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0213       ENDIF
                0214 
                0215 C Only do I/O if I am the master thread
                0216       IF ( iAmDoingIO ) THEN
37f13932c5 Jean*0217 
                0218 C Assign special directory
                0219         IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
                0220          pfName= fName
                0221         ELSE
                0222          WRITE(pfName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
                0223         ENDIF
                0224         pIL=ILNBLNK( pfName )
                0225 
                0226 C Assign a free unit number as the I/O channel for this routine
                0227         CALL MDSFINDUNIT( dUnit, myThid )
                0228 
                0229 C Check first for global file with simple name (ie. fName)
                0230         dataFName = fName
                0231         INQUIRE( file=dataFName, exist=exst )
                0232         IF (exst) THEN
8ae8238aa3 Jean*0233           IF ( debugLevel .GE. debLevB ) THEN
37f13932c5 Jean*0234             WRITE(msgBuf,'(A,A)')
                0235      &      ' MDS_READ_FIELD: opening global file: ',dataFName(1:IL)
                0236             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0237      &                          SQUEEZE_RIGHT, myThid)
37f13932c5 Jean*0238           ENDIF
                0239           globalFile = .TRUE.
                0240         ENDIF
                0241 
                0242 C If negative check for global file with MDS name (ie. fName.data)
                0243         IF (.NOT. globalFile) THEN
                0244           WRITE(dataFName,'(2a)') fName(1:IL),'.data'
                0245           INQUIRE( file=dataFName, exist=exst )
                0246           IF (exst) THEN
8ae8238aa3 Jean*0247            IF ( debugLevel .GE. debLevB ) THEN
37f13932c5 Jean*0248             WRITE(msgBuf,'(A,A)')
                0249      &      ' MDS_READ_FIELD: opening global file: ',dataFName(1:IL+5)
                0250             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0251      &                          SQUEEZE_RIGHT, myThid)
37f13932c5 Jean*0252            ENDIF
                0253            globalFile = .TRUE.
                0254           ENDIF
                0255         ENDIF
                0256 
                0257 C- endif iAmDoingIO
                0258       ENDIF
                0259 
                0260 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0261 
                0262       IF ( useSingleCPUIO ) THEN
                0263 
                0264 C master thread of process 0, only, opens a global file
                0265        IF ( iAmDoingIO ) THEN
                0266 C If global file is visible to process 0, then open it here.
                0267 C Otherwise stop program.
                0268          IF ( globalFile) THEN
9a33636256 Jean*0269           length_of_rec = MDS_RECLEN( filePrec, xSize*ySize, myThid )
3d93c0a01e Ou W*0270           OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
37f13932c5 Jean*0271      &         access='direct', recl=length_of_rec )
                0272          ELSE
                0273           WRITE(msgBuf,'(2A)')
                0274      &      ' MDS_READ_FIELD: filename: ', dataFName(1:IL+5)
                0275           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0276      &                        SQUEEZE_RIGHT, myThid)
37f13932c5 Jean*0277           CALL PRINT_ERROR( msgBuf, myThid )
                0278           WRITE(msgBuf,'(A)')
                0279      &      ' MDS_READ_FIELD: File does not exist'
                0280           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0281      &                        SQUEEZE_RIGHT, myThid)
37f13932c5 Jean*0282           CALL PRINT_ERROR( msgBuf, myThid )
                0283           STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0284          ENDIF
                0285 C- endif iAmDoingIO
                0286        ENDIF
                0287 
c0c8c1b5a1 Jean*0288        DO k=kLo,kHi
37f13932c5 Jean*0289 
                0290 C master thread of process 0, only, read from file
                0291         IF ( iAmDoingIO ) THEN
9a33636256 Jean*0292           irec = 1 + k-kLo + (irecord-1)*nNz
37f13932c5 Jean*0293           IF (filePrec .EQ. precFloat32) THEN
e039218b63 Jean*0294            READ(dUnit,rec=irec) ( xy_buffer_r4(i),i=1,xSize*ySize )
37f13932c5 Jean*0295 #ifdef _BYTESWAPIO
e039218b63 Jean*0296            CALL MDS_BYTESWAPR4( xSize*ySize, xy_buffer_r4 )
37f13932c5 Jean*0297 #endif
8decba0243 Jean*0298           ELSE
e039218b63 Jean*0299            READ(dUnit,rec=irec) ( xy_buffer_r8(i),i=1,xSize*ySize )
20b1679b8a Jean*0300 #ifdef _BYTESWAPIO
e039218b63 Jean*0301            CALL MDS_BYTESWAPR8( xSize*ySize, xy_buffer_r8 )
20b1679b8a Jean*0302 #endif
                0303           ENDIF
37f13932c5 Jean*0304 C- endif iAmDoingIO
                0305         ENDIF
08e96a842a Jean*0306 
8decba0243 Jean*0307 C Wait for all thread to finish. This prevents other threads to continue
                0308 C  to acces shared buffer while master thread is loading data into
                0309         CALL BAR2( myThid )
                0310 
08e96a842a Jean*0311         IF ( filePrec.EQ.precFloat32 ) THEN
                0312           CALL SCATTER_2D_R4(
                0313      U                        xy_buffer_r4,
                0314      O                        sharedLocBuf_r4,
                0315      I                        xSize, ySize,
f7508ac42d Jean*0316      I                        useExch2ioLayOut, .FALSE., myThid )
8decba0243 Jean*0317 C All threads wait for Master to finish loading into shared buffer
                0318           CALL BAR2( myThid )
08e96a842a Jean*0319           IF ( arrType.EQ.'RS' ) THEN
608f4af3c8 Jean*0320             CALL MDS_PASS_R4toRS( sharedLocBuf_r4, fldRS,
2186fe42a7 Jean*0321      I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
08e96a842a Jean*0322           ELSEIF ( arrType.EQ.'RL' ) THEN
608f4af3c8 Jean*0323             CALL MDS_PASS_R4toRL( sharedLocBuf_r4, fldRL,
2186fe42a7 Jean*0324      I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
08e96a842a Jean*0325           ELSE
                0326             WRITE(msgBuf,'(A)')
                0327      &          ' MDS_READ_FIELD: illegal value for arrType'
                0328             CALL PRINT_ERROR( msgBuf, myThid )
8decba0243 Jean*0329             CALL ALL_PROC_DIE( myThid )
08e96a842a Jean*0330             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0331           ENDIF
8decba0243 Jean*0332         ELSEIF ( filePrec.EQ.precFloat64 ) THEN
08e96a842a Jean*0333           CALL SCATTER_2D_R8(
                0334      U                        xy_buffer_r8,
                0335      O                        sharedLocBuf_r8,
                0336      I                        xSize, ySize,
f7508ac42d Jean*0337      I                        useExch2ioLayOut, .FALSE., myThid )
8decba0243 Jean*0338 C All threads wait for Master to finish loading into shared buffer
                0339           CALL BAR2( myThid )
08e96a842a Jean*0340           IF ( arrType.EQ.'RS' ) THEN
608f4af3c8 Jean*0341             CALL MDS_PASS_R8toRS( sharedLocBuf_r8, fldRS,
2186fe42a7 Jean*0342      I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
08e96a842a Jean*0343           ELSEIF ( arrType.EQ.'RL' ) THEN
608f4af3c8 Jean*0344             CALL MDS_PASS_R8toRL( sharedLocBuf_r8, fldRL,
2186fe42a7 Jean*0345      I                  0, 0, 1, k, kSize, 0, 0, .TRUE., myThid )
08e96a842a Jean*0346           ELSE
                0347             WRITE(msgBuf,'(A)')
37f13932c5 Jean*0348      &          ' MDS_READ_FIELD: illegal value for arrType'
08e96a842a Jean*0349             CALL PRINT_ERROR( msgBuf, myThid )
8decba0243 Jean*0350             CALL ALL_PROC_DIE( myThid )
08e96a842a Jean*0351             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0352           ENDIF
8decba0243 Jean*0353         ELSE
                0354           WRITE(msgBuf,'(A)')
                0355      &            ' MDS_READ_FIELD: illegal value for filePrec'
                0356           CALL PRINT_ERROR( msgBuf, myThid )
                0357           CALL ALL_PROC_DIE( myThid )
                0358           STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
37f13932c5 Jean*0359         ENDIF
                0360 
                0361        ENDDO
c0c8c1b5a1 Jean*0362 c      ENDDO k=kLo,kHi
37f13932c5 Jean*0363 
                0364        IF ( iAmDoingIO ) THEN
                0365          CLOSE( dUnit )
                0366        ENDIF
                0367 
                0368 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0369 C---  else .NOT.useSingleCpuIO
                0370       ELSE
                0371 
8decba0243 Jean*0372 C Wait for all thread to finish. This prevents other threads to continue
                0373 C  to acces 3-D buffer while master thread is reading
2186fe42a7 Jean*0374 c      CALL BAR2( myThid )
8decba0243 Jean*0375 
37f13932c5 Jean*0376 C Only do I/O if I am the master thread
                0377        IF ( iAmDoingIO ) THEN
                0378 
                0379 C If we are reading from a global file then we open it here
                0380         IF (globalFile) THEN
9a33636256 Jean*0381          length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
3d93c0a01e Ou W*0382          OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
37f13932c5 Jean*0383      &        access='direct', recl=length_of_rec )
                0384          fileIsOpen=.TRUE.
                0385         ENDIF
                0386 
                0387 C Loop over all tiles
                0388         DO bj=1,nSy
                0389          DO bi=1,nSx
8decba0243 Jean*0390           bBij = sNx*sNy*nNz*( bi-1 + (bj-1)*nSx )
37f13932c5 Jean*0391 
9a33636256 Jean*0392           IF (globalFile) THEN
                0393 C--- Case of 1 Global file:
                0394 
                0395 c         IF (fileIsOpen) THEN
f7508ac42d Jean*0396            tNx = sNx
37f13932c5 Jean*0397            tNy = sNy
f7508ac42d Jean*0398            global_nTx = xSize/sNx
                0399            tBx = myXGlobalLo-1 + (bi-1)*sNx
                0400            tBy = myYGlobalLo-1 + (bj-1)*sNy
                0401            iGjLoc = 0
                0402            jGjLoc = 1
37f13932c5 Jean*0403 #ifdef ALLOW_EXCH2
f7508ac42d Jean*0404            IF ( useExch2ioLayOut ) THEN
c424ee7cc7 Jean*0405              tN = W2_myTileList(bi,bj)
f7508ac42d Jean*0406 c            tNx = exch2_tNx(tN)
                0407 c            tNy = exch2_tNy(tN)
                0408 c            global_nTx = exch2_global_Nx/tNx
                0409              tBx = exch2_txGlobalo(tN) - 1
                0410              tBy = exch2_tyGlobalo(tN) - 1
                0411              IF   ( exch2_mydNx(tN) .GT. xSize ) THEN
                0412 C-           face x-size larger than glob-size : fold it
                0413                iGjLoc = 0
                0414                jGjLoc = exch2_mydNx(tN) / xSize
                0415              ELSEIF ( exch2_tNy(tN) .GT. ySize ) THEN
                0416 C-           tile y-size larger than glob-size : make a long line
                0417                iGjLoc = exch2_mydNx(tN)
                0418                jGjLoc = 0
                0419              ELSE
                0420 C-           default (face fit into global-IO-array)
                0421                iGjLoc = 0
                0422                jGjLoc = 1
                0423              ENDIF
20b1679b8a Jean*0424            ENDIF
37f13932c5 Jean*0425 #endif /* ALLOW_EXCH2 */
8decba0243 Jean*0426 
c0c8c1b5a1 Jean*0427            DO k=kLo,kHi
37f13932c5 Jean*0428             DO j=1,tNy
9a33636256 Jean*0429              irec = 1 + ( tBx + (j-1)*iGjLoc )/sNx
                0430      &                + ( tBy + (j-1)*jGjLoc )*global_nTx
                0431      &            +( k-kLo + (irecord-1)*nNz )*global_nTx*ySize
8decba0243 Jean*0432              i1 = bBij + 1 + (j-1)*sNx + (k-kLo)*sNx*sNy
                0433              i2 = bBij +         j*sNx + (k-kLo)*sNx*sNy
                0434              IF ( filePrec.EQ.precFloat32 ) THEN
                0435               READ(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
37f13932c5 Jean*0436              ELSE
8decba0243 Jean*0437               READ(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
37f13932c5 Jean*0438              ENDIF
8decba0243 Jean*0439 C End of j,k loops
37f13932c5 Jean*0440             ENDDO
                0441            ENDDO
9a33636256 Jean*0442 
37f13932c5 Jean*0443 C end if fileIsOpen
9a33636256 Jean*0444 c         ENDIF
                0445 
                0446           ELSE
                0447 C--- Case of 1 file per tile (globalFile=F):
                0448 
                0449 C If we are reading from a tiled MDS file then we open each one here
                0450            iG=bi+(myXGlobalLo-1)/sNx
                0451            jG=bj+(myYGlobalLo-1)/sNy
                0452            WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
                0453      &            pfName(1:pIL),'.',iG,'.',jG,'.data'
                0454            INQUIRE( file=dataFName, exist=exst )
                0455 C Of course, we only open the file if the tile is "active"
                0456 C (This is a place-holder for the active/passive mechanism
                0457            IF (exst) THEN
8ae8238aa3 Jean*0458             IF ( debugLevel .GE. debLevB ) THEN
9a33636256 Jean*0459              WRITE(msgBuf,'(A,A)')
                0460      &       ' MDS_READ_FIELD: opening file: ',dataFName(1:pIL+13)
                0461              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0462      &                        SQUEEZE_RIGHT, myThid)
9a33636256 Jean*0463             ENDIF
8decba0243 Jean*0464             length_of_rec = MDS_RECLEN( filePrec, sNx*sNy*nNz, myThid )
3d93c0a01e Ou W*0465             OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
9a33636256 Jean*0466      &            access='direct', recl=length_of_rec )
                0467             fileIsOpen=.TRUE.
                0468            ELSE
                0469             fileIsOpen=.FALSE.
                0470             WRITE(msgBuf,'(4A)') ' MDS_READ_FIELD: filename: ',
                0471      &             fName(1:IL),' , ', dataFName(1:pIL+13)
                0472             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0473      &                          SQUEEZE_RIGHT, myThid)
9a33636256 Jean*0474             CALL PRINT_ERROR( msgBuf, myThid )
                0475             WRITE(msgBuf,'(A)')
                0476      &      ' MDS_READ_FIELD: Files DO not exist'
                0477             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
a0e387243c Jean*0478      &                          SQUEEZE_RIGHT, myThid)
9a33636256 Jean*0479             CALL PRINT_ERROR( msgBuf, myThid )
                0480             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0481            ENDIF
                0482 
8decba0243 Jean*0483            irec = irecord
                0484            i1 = bBij + 1
                0485            i2 = bBij + sNx*sNy*nNz
                0486            IF ( filePrec.EQ.precFloat32 ) THEN
                0487              READ(dUnit,rec=irec) (shared3dBuf_r4(i),i=i1,i2)
                0488            ELSE
                0489              READ(dUnit,rec=irec) (shared3dBuf_r8(i),i=i1,i2)
                0490            ENDIF
9a33636256 Jean*0491 
                0492 C here We close the tiled MDS file
                0493            IF ( fileIsOpen ) THEN
8decba0243 Jean*0494              CLOSE( dUnit )
                0495              fileIsOpen = .FALSE.
9a33636256 Jean*0496            ENDIF
                0497 
                0498 C--- End Global File / tile-file cases
37f13932c5 Jean*0499           ENDIF
9a33636256 Jean*0500 
37f13932c5 Jean*0501 C End of bi,bj loops
                0502          ENDDO
                0503         ENDDO
                0504 
                0505 C If global file was opened then close it
                0506         IF (fileIsOpen .AND. globalFile) THEN
8decba0243 Jean*0507           CLOSE( dUnit )
                0508           fileIsOpen = .FALSE.
37f13932c5 Jean*0509         ENDIF
                0510 
8decba0243 Jean*0511 #ifdef _BYTESWAPIO
                0512         IF ( filePrec.EQ.precFloat32 ) THEN
                0513           CALL MDS_BYTESWAPR4( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r4 )
                0514         ELSE
                0515           CALL MDS_BYTESWAPR8( sNx*sNy*nNz*nSx*nSy, shared3dBuf_r8 )
                0516         ENDIF
                0517 #endif
                0518 
37f13932c5 Jean*0519 C- endif iAmDoingIO
                0520        ENDIF
                0521 
8decba0243 Jean*0522 C All threads wait for Master to finish reading into shared buffer
                0523        CALL BAR2( myThid )
                0524 
608f4af3c8 Jean*0525 C---    Copy from 3-D buffer to fldRL/RS (multi-threads):
8decba0243 Jean*0526         IF ( filePrec.EQ.precFloat32 ) THEN
                0527           IF ( arrType.EQ.'RS' ) THEN
608f4af3c8 Jean*0528             CALL MDS_PASS_R4toRS( shared3dBuf_r4, fldRS,
2186fe42a7 Jean*0529      I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
8decba0243 Jean*0530           ELSEIF ( arrType.EQ.'RL' ) THEN
608f4af3c8 Jean*0531             CALL MDS_PASS_R4toRL( shared3dBuf_r4, fldRL,
2186fe42a7 Jean*0532      I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
8decba0243 Jean*0533           ELSE
                0534             WRITE(msgBuf,'(A)')
                0535      &         ' MDS_READ_FIELD: illegal value for arrType'
                0536             CALL PRINT_ERROR( msgBuf, myThid )
                0537             CALL ALL_PROC_DIE( myThid )
                0538             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0539           ENDIF
                0540         ELSEIF ( filePrec.EQ.precFloat64 ) THEN
                0541           IF ( arrType.EQ.'RS' ) THEN
608f4af3c8 Jean*0542             CALL MDS_PASS_R8toRS( shared3dBuf_r8, fldRS,
2186fe42a7 Jean*0543      I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
8decba0243 Jean*0544           ELSEIF ( arrType.EQ.'RL' ) THEN
608f4af3c8 Jean*0545             CALL MDS_PASS_R8toRL( shared3dBuf_r8, fldRL,
2186fe42a7 Jean*0546      I              0, 0, nNz, kLo, kSize, 0, 0, .TRUE., myThid )
8decba0243 Jean*0547           ELSE
                0548             WRITE(msgBuf,'(A)')
                0549      &         ' MDS_READ_FIELD: illegal value for arrType'
                0550             CALL PRINT_ERROR( msgBuf, myThid )
                0551             CALL ALL_PROC_DIE( myThid )
                0552             STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0553           ENDIF
                0554         ELSE
                0555           WRITE(msgBuf,'(A)')
                0556      &         ' MDS_READ_FIELD: illegal value for filePrec'
                0557           CALL PRINT_ERROR( msgBuf, myThid )
                0558           CALL ALL_PROC_DIE( myThid )
                0559           STOP 'ABNORMAL END: S/R MDS_READ_FIELD'
                0560         ENDIF
                0561 
2186fe42a7 Jean*0562 C Wait for all threads to finish getting data from 3-D shared buffer.
                0563 C  This prevents the master-thread to change the buffer content before
                0564 C  every one got his data.
                0565        CALL BAR2( myThid )
                0566 
37f13932c5 Jean*0567 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0568 C     if useSingleCpuIO / else / end
                0569       ENDIF
                0570 
                0571       RETURN
                0572       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!