Back to home page

MITgcm
 
 

    

File indexing completed on 2023-08-03 05:10:21 UTC

view on githubraw file Latest commit 57622776 on 2023-08-02 18:02:22 UTC
9c019881ee Jean*0001 #include "MDSIO_OPTIONS.h"
                0002 
                0003 C--  File mdsio_read_section.F: Routines to handle mid-level I/O interface.
                0004 C--   Contents
                0005 C--   o MDS_READ_SEC_XZ
                0006 C--   o MDS_READ_SEC_YZ
                0007 
                0008 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0009 
                0010 CBOP
                0011 C !ROUTINE: MDS_READ_SEC_XZ
                0012 C !INTERFACE:
                0013       SUBROUTINE MDS_READ_SEC_XZ(
                0014      I   fName,
                0015      I   filePrec,
                0016      I   useCurrentDir,
                0017      I   arrType,
57622776fd Jean*0018      I   kSize, kLo, kHi,
9c019881ee Jean*0019      O   fldRL, fldRS,
                0020      I   irecord,
                0021      I   myThid )
                0022 
                0023 C !DESCRIPTION
                0024 C Arguments:
                0025 C
                0026 C fName       string  :: base name for file to read
                0027 C filePrec    integer :: number of bits per word in file (32 or 64)
                0028 C useCurrentDir(logic):: always read from the current directory (even if
                0029 C                        "mdsioLocalDir" is set)
3daafce20b Jean*0030 C arrType     char(2) :: which array (fldRL/RS) to read into, either "RL" or "RS"
57622776fd Jean*0031 C kSize       integer :: size of second dimension, normally either 1 or Nr
                0032 C kLo         integer :: 1rst vertical level (of array fldRL/RS) to read-in
                0033 C kHi         integer :: last vertical level (of array fldRL/RS) to read-in
9c019881ee Jean*0034 C fldRL         RL    :: array to read into if arrType="RL", fldRL(:,kSize,:,:)
                0035 C fldRS         RS    :: array to read into if arrType="RS", fldRS(:,kSize,:,:)
                0036 C irecord     integer :: record number to read
                0037 C myThid      integer :: thread identifier
                0038 C
                0039 C MDS_READ_SEC_XZ first checks to see IF the file "fName" exists, then
                0040 C if the file "fName.data" exists and finally the tiled files of the
                0041 C form "fName.xxx.yyy.data" exist.
                0042 C The precision of the file is decsribed by filePrec, set either
                0043 C  to floatPrec32 or floatPrec64. The char*(2) string arrType, either "RL"
                0044 C  or "RS", selects which array is filled in, either fldRL or fldRS.
                0045 C This routine reads vertical slices (X-Z) including the overlap region.
                0046 C irecord is the record number to be read and must be >= 1.
                0047 C The file data is stored in fldRL/RS *but* the overlaps are *not* updated.
                0048 C
                0049 C Created: 06/03/00 spk@ocean.mit.edu
                0050 CEOP
                0051 
                0052 C !USES:
                0053       IMPLICIT NONE
                0054 C Global variables / common blocks
                0055 #include "SIZE.h"
                0056 #include "EEPARAMS.h"
                0057 #include "PARAMS.h"
87c5bcbdbd Oliv*0058 #ifdef ALLOW_EXCH2
                0059 #include "W2_EXCH2_SIZE.h"
                0060 #include "W2_EXCH2_TOPOLOGY.h"
                0061 #include "W2_EXCH2_PARAMS.h"
                0062 #endif /* ALLOW_EXCH2 */
9c019881ee Jean*0063 
                0064 C !INPUT PARAMETERS:
                0065       CHARACTER*(*) fName
                0066       INTEGER filePrec
                0067       LOGICAL useCurrentDir
                0068       CHARACTER*(2) arrType
57622776fd Jean*0069       INTEGER kSize, kLo, kHi
9c019881ee Jean*0070       INTEGER irecord
                0071       INTEGER myThid
                0072 C !OUTPUT PARAMETERS:
                0073       _RL  fldRL(*)
                0074       _RS  fldRS(*)
                0075 
                0076 C !FUNCTIONS:
                0077       INTEGER ILNBLNK
                0078       INTEGER MDS_RECLEN
                0079       EXTERNAL ILNBLNK, MDS_RECLEN
                0080 
                0081 C !LOCAL VARIABLES:
57622776fd Jean*0082       CHARACTER*(MAX_LEN_FNAM) dataFName, pfName
                0083       INTEGER IL, pIL, dUnit, nLev, irec
                0084       INTEGER iG, jG, bi, bj, k, kL
9c019881ee Jean*0085       LOGICAL exst
                0086       Real*4 r4seg(sNx)
                0087       Real*8 r8seg(sNx)
57622776fd Jean*0088       LOGICAL globalFile, fileIsOpen
9c019881ee Jean*0089       INTEGER length_of_rec
57622776fd Jean*0090       CHARACTER*(MAX_LEN_MBUF) msgBuf
87c5bcbdbd Oliv*0091 #ifdef ALLOW_EXCH2
57622776fd Jean*0092       INTEGER tGx, tNx, tN
87c5bcbdbd Oliv*0093 #endif /* ALLOW_EXCH2 */
9c019881ee Jean*0094 C     ------------------------------------------------------------------
                0095 
                0096 C Only do I/O if I am the master thread
                0097       _BEGIN_MASTER( myThid )
                0098 
                0099 C Record number must be >= 1
                0100       IF (irecord .LT. 1) THEN
                0101        WRITE(msgBuf,'(A,I9.8)')
                0102      &   ' MDS_READ_SEC_XZ: argument irecord = ',irecord
                0103        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0104      &                     SQUEEZE_RIGHT, myThid )
                0105        WRITE(msgBuf,'(A)')
                0106      &   ' MDS_READ_SEC_XZ: Invalid value for irecord'
                0107        CALL PRINT_ERROR( msgBuf, myThid )
                0108        STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ'
                0109       ENDIF
                0110 
                0111 C Assume nothing
                0112       globalFile = .FALSE.
                0113       fileIsOpen = .FALSE.
                0114       IL  = ILNBLNK( fName )
                0115       pIL = ILNBLNK( mdsioLocalDir )
                0116 
                0117 C Assign special directory
                0118       IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
                0119        pfName= fName
                0120       ELSE
                0121        WRITE(pfName,'(2a)') mdsioLocalDir(1:pIL), fName(1:IL)
                0122       ENDIF
                0123       pIL=ILNBLNK( pfName )
                0124 
57622776fd Jean*0125 C Set number of levels to read:
                0126       nLev = kHi - kLo + 1
                0127 
9c019881ee Jean*0128 C Assign a free unit number as the I/O channel for this routine
                0129       CALL MDSFINDUNIT( dUnit, myThid )
                0130 
                0131 C Check first for global file with simple name (ie. fName)
                0132       dataFName = fName
                0133       INQUIRE( file=dataFName, exist=exst )
                0134       IF (exst) THEN
ae605e558b Jean*0135        IF ( debugLevel .GE. debLevB ) THEN
9c019881ee Jean*0136         WRITE(msgBuf,'(A,A)')
                0137      &   ' MDS_READ_SEC_XZ: opening global file: ',dataFName(1:IL)
                0138         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0139      &                      SQUEEZE_RIGHT, myThid )
                0140        ENDIF
                0141        globalFile = .TRUE.
                0142       ENDIF
                0143 
                0144 C If negative check for global file with MDS name (ie. fName.data)
                0145       IF (.NOT. globalFile) THEN
                0146        WRITE(dataFName,'(2A)') fName(1:IL),'.data'
                0147        INQUIRE( file=dataFName, exist=exst )
                0148        IF (exst) THEN
ae605e558b Jean*0149         IF ( debugLevel .GE. debLevB ) THEN
9c019881ee Jean*0150          WRITE(msgBuf,'(A,A)')
                0151      &    ' MDS_READ_SEC_XZ: opening global file: ',dataFName(1:IL+5)
                0152          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0153      &                       SQUEEZE_RIGHT, myThid )
                0154         ENDIF
                0155         globalFile = .TRUE.
                0156        ENDIF
                0157       ENDIF
                0158 
                0159 C If we are reading from a global file then we open it here
                0160       IF (globalFile) THEN
                0161        length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
3d93c0a01e Ou W*0162        OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
9c019881ee Jean*0163      &       access='direct', recl=length_of_rec )
                0164        fileIsOpen=.TRUE.
                0165       ENDIF
                0166 
                0167 C Loop over all tiles
                0168       DO bj=1,nSy
                0169        DO bi=1,nSx
                0170 C If we are reading from a tiled MDS file then we open each one here
                0171         IF (.NOT. globalFile) THEN
                0172          iG=bi+(myXGlobalLo-1)/sNx
                0173          jG=bj+(myYGlobalLo-1)/sNy
                0174          WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
                0175      &              pfName(1:pIL),'.',iG,'.',jG,'.data'
                0176          INQUIRE( file=dataFName, exist=exst )
                0177 C Of course, we only open the file IF the tile is "active"
                0178 C (This is a place-holder for the active/passive mechanism
                0179          IF (exst) THEN
ae605e558b Jean*0180           IF ( debugLevel .GE. debLevB ) THEN
9c019881ee Jean*0181            WRITE(msgBuf,'(A,A)')
                0182      &      ' MDS_READ_SEC_XZ: opening file: ',dataFName(1:pIL+13)
                0183            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0184      &                         SQUEEZE_RIGHT, myThid )
                0185           ENDIF
                0186           length_of_rec = MDS_RECLEN( filePrec, sNx, myThid )
3d93c0a01e Ou W*0187           OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
9c019881ee Jean*0188      &          access='direct', recl=length_of_rec )
                0189           fileIsOpen=.TRUE.
                0190          ELSE
                0191           fileIsOpen=.FALSE.
                0192           WRITE(msgBuf,'(4A)') ' MDS_READ_SEC_XZ: filename: ',
                0193      &             fName(1:IL),' , ', dataFName(1:pIL+13)
                0194           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0195      &                        SQUEEZE_RIGHT, myThid )
                0196           WRITE(msgBuf,'(A)')
                0197      &      ' MDS_READ_SEC_XZ: Files DO not exist'
                0198           CALL PRINT_ERROR( msgBuf, myThid )
                0199           STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ'
                0200          ENDIF
                0201         ENDIF
                0202 
                0203         IF (fileIsOpen) THEN
87c5bcbdbd Oliv*0204 #ifdef ALLOW_EXCH2
                0205 C layout of global x-z section files is "xStack"
                0206          tN = W2_myTileList(bi,bj)
                0207          tGx = exch2_txXStackLo(tN)
                0208          tNx = exch2_tNx(tN)
                0209 #endif /* ALLOW_EXCH2 */
57622776fd Jean*0210          DO k=1,nLev
                0211            kL = k + kLo - 1
9c019881ee Jean*0212            IF (globalFile) THEN
87c5bcbdbd Oliv*0213 #ifdef ALLOW_EXCH2
                0214 C record length is sNx==tNx
                0215             irec = 1 + ( tGx-1
57622776fd Jean*0216      &                   + ( k-1 + (irecord-1)*nLev )*exch2_xStack_Nx
87c5bcbdbd Oliv*0217      &                 )/tNx
                0218 #else /* ALLOW_EXCH2 */
9c019881ee Jean*0219             iG = myXGlobalLo-1 + (bi-1)*sNx
                0220             jG = (myYGlobalLo-1)/sNy + (bj-1)
57622776fd Jean*0221             irec = 1 + INT(iG/sNx) + nSx*nPx*(k-1)
                0222      &           + nSx*nPx*nLev*(irecord-1)
87c5bcbdbd Oliv*0223 #endif /* ALLOW_EXCH2 */
9c019881ee Jean*0224            ELSE
                0225             iG = 0
                0226             jG = 0
57622776fd Jean*0227             irec = k + nLev*(irecord-1)
9c019881ee Jean*0228            ENDIF
                0229            IF (filePrec .EQ. precFloat32) THEN
                0230             READ(dUnit,rec=irec) r4seg
                0231 #ifdef _BYTESWAPIO
                0232             CALL MDS_BYTESWAPR4(sNx,r4seg)
                0233 #endif
                0234             IF (arrType .EQ. 'RS') THEN
57622776fd Jean*0235              CALL MDS_SEG4toRS_2D( sNx,OLx,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0236      &                             r4seg,fldRS )
                0237             ELSEIF (arrType .EQ. 'RL') THEN
57622776fd Jean*0238              CALL MDS_SEG4toRL_2D( sNx,OLx,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0239      &                             r4seg,fldRL )
                0240             ELSE
                0241              WRITE(msgBuf,'(A)')
                0242      &         ' MDS_READ_SEC_XZ: illegal value for arrType'
                0243              CALL PRINT_ERROR( msgBuf, myThid )
                0244              STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ'
                0245             ENDIF
                0246            ELSEIF (filePrec .EQ. precFloat64) THEN
                0247             READ(dUnit,rec=irec) r8seg
                0248 #ifdef _BYTESWAPIO
                0249             CALL MDS_BYTESWAPR8( sNx, r8seg )
                0250 #endif
                0251             IF (arrType .EQ. 'RS') THEN
57622776fd Jean*0252              CALL MDS_SEG8toRS_2D(sNx,OLx,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0253      &                             r8seg,fldRS )
                0254             ELSEIF (arrType .EQ. 'RL') THEN
57622776fd Jean*0255              CALL MDS_SEG8toRL_2D(sNx,OLx,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0256      &                             r8seg,fldRL )
                0257             ELSE
                0258              WRITE(msgBuf,'(A)')
                0259      &         ' MDS_READ_SEC_XZ: illegal value for arrType'
                0260              CALL PRINT_ERROR( msgBuf, myThid )
                0261              STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ'
                0262             ENDIF
                0263            ELSE
                0264             WRITE(msgBuf,'(A)')
                0265      &        ' MDS_READ_SEC_XZ: illegal value for filePrec'
                0266             CALL PRINT_ERROR( msgBuf, myThid )
                0267             STOP 'ABNORMAL END: S/R MDS_READ_SEC_XZ'
                0268            ENDIF
                0269 C End of k loop
                0270          ENDDO
                0271          IF (.NOT. globalFile) THEN
                0272           CLOSE( dUnit )
                0273           fileIsOpen = .FALSE.
                0274          ENDIF
                0275         ENDIF
                0276 C End of bi,bj loops
                0277        ENDDO
                0278       ENDDO
                0279 
                0280 C If global file was opened then close it
                0281       IF (fileIsOpen .AND. globalFile) THEN
                0282        CLOSE( dUnit )
                0283        fileIsOpen = .FALSE.
                0284       ENDIF
                0285 
                0286       _END_MASTER( myThid )
                0287 
                0288 C     ------------------------------------------------------------------
                0289       RETURN
                0290       END
                0291 
                0292 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0293 
                0294 CBOP
                0295 C !ROUTINE: MDS_READ_SEC_YZ
                0296 C !INTERFACE:
                0297       SUBROUTINE MDS_READ_SEC_YZ(
                0298      I   fName,
                0299      I   filePrec,
                0300      I   useCurrentDir,
                0301      I   arrType,
57622776fd Jean*0302      I   kSize, kLo, kHi,
9c019881ee Jean*0303      O   fldRL, fldRS,
                0304      I   irecord,
                0305      I   myThid )
                0306 
                0307 C !DESCRIPTION
                0308 C Arguments:
                0309 C
                0310 C fName       string  :: base name for file to read
                0311 C filePrec    integer :: number of bits per word in file (32 or 64)
                0312 C useCurrentDir(logic):: always read from the current directory (even if
                0313 C                        "mdsioLocalDir" is set)
3daafce20b Jean*0314 C arrType     char(2) :: which array (fldRL/RS) to read into, either "RL" or "RS"
57622776fd Jean*0315 C kSize       integer :: size of second dimension, normally either 1 or Nr
                0316 C kLo         integer :: 1rst vertical level (of array fldRL/RS) to read-in
                0317 C kHi         integer :: last vertical level (of array fldRL/RS) to read-in
9c019881ee Jean*0318 C fldRL         RL    :: array to read into if arrType="RL", fldRL(:,kSize,:,:)
                0319 C fldRS         RS    :: array to read into if arrType="RS", fldRS(:,kSize,:,:)
                0320 C irecord     integer :: record number to read
                0321 C myThid      integer :: thread identifier
                0322 C
                0323 C MDS_READ_SEC_YZ first checks to see IF the file "fName" exists, then
                0324 C if the file "fName.data" exists and finally the tiled files of the
                0325 C form "fName.xxx.yyy.data" exist.
                0326 C The precision of the file is decsribed by filePrec, set either
                0327 C  to floatPrec32 or floatPrec64. The char*(2) string arrType, either "RL"
                0328 C  or "RS", selects which array is filled in, either fldRL or fldRS.
                0329 C This routine reads vertical slices (Y-Z) including the overlap region.
                0330 C irecord is the record number to be read and must be >= 1.
                0331 C The file data is stored in fldRL/RS *but* the overlaps are *not* updated.
                0332 C
                0333 C Created: 06/03/00 spk@ocean.mit.edu
                0334 CEOP
                0335 
                0336 C !USES:
                0337       IMPLICIT NONE
                0338 C Global variables / common blocks
                0339 #include "SIZE.h"
                0340 #include "EEPARAMS.h"
                0341 #include "PARAMS.h"
87c5bcbdbd Oliv*0342 #ifdef ALLOW_EXCH2
                0343 #include "W2_EXCH2_SIZE.h"
                0344 #include "W2_EXCH2_TOPOLOGY.h"
                0345 #include "W2_EXCH2_PARAMS.h"
                0346 #endif /* ALLOW_EXCH2 */
9c019881ee Jean*0347 
                0348 C !INPUT PARAMETERS:
                0349       CHARACTER*(*) fName
                0350       INTEGER filePrec
                0351       LOGICAL useCurrentDir
                0352       CHARACTER*(2) arrType
57622776fd Jean*0353       INTEGER kSize, kLo, kHi
9c019881ee Jean*0354       INTEGER irecord
                0355       INTEGER myThid
                0356 C !OUTPUT PARAMETERS:
                0357       _RL  fldRL(*)
                0358       _RS  fldRS(*)
                0359 
                0360 C !FUNCTIONS:
                0361       INTEGER ILNBLNK
                0362       INTEGER MDS_RECLEN
                0363       EXTERNAL ILNBLNK, MDS_RECLEN
                0364 
                0365 C !LOCAL VARIABLES:
57622776fd Jean*0366       CHARACTER*(MAX_LEN_FNAM) dataFName, pfName
                0367       INTEGER IL, pIL, dUnit, nLev, irec
                0368       INTEGER iG, jG, bi, bj, k, kL
9c019881ee Jean*0369       LOGICAL exst
                0370       Real*4 r4seg(sNy)
                0371       Real*8 r8seg(sNy)
57622776fd Jean*0372       LOGICAL globalFile, fileIsOpen
9c019881ee Jean*0373       INTEGER length_of_rec
57622776fd Jean*0374       CHARACTER*(MAX_LEN_MBUF) msgBuf
87c5bcbdbd Oliv*0375 #ifdef ALLOW_EXCH2
57622776fd Jean*0376       INTEGER tGy, tNy, tN
87c5bcbdbd Oliv*0377 #endif /* ALLOW_EXCH2 */
                0378 
9c019881ee Jean*0379 C     ------------------------------------------------------------------
                0380 
                0381 C Only do I/O if I am the master thread
                0382       _BEGIN_MASTER( myThid )
                0383 
                0384 C Record number must be >= 1
                0385       IF (irecord .LT. 1) THEN
                0386        WRITE(msgBuf,'(A,I9.8)')
                0387      &   ' MDS_READ_SEC_YZ: argument irecord = ',irecord
                0388        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0389      &                     SQUEEZE_RIGHT, myThid )
                0390        WRITE(msgBuf,'(A)')
                0391      &   ' MDS_READ_SEC_YZ: Invalid value for irecord'
                0392        CALL PRINT_ERROR( msgBuf, myThid )
                0393        STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ'
                0394       ENDIF
                0395 
                0396 C Assume nothing
                0397       globalFile = .FALSE.
                0398       fileIsOpen = .FALSE.
                0399       IL  = ILNBLNK( fName )
                0400       pIL = ILNBLNK( mdsioLocalDir )
                0401 
                0402 C Assign special directory
                0403       IF ( useCurrentDir .OR. pIL.EQ.0 ) THEN
                0404        pfName= fName
                0405       ELSE
                0406        WRITE(pfName,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL)
                0407       ENDIF
                0408       pIL=ILNBLNK( pfName )
                0409 
57622776fd Jean*0410 C Set number of levels to read:
                0411       nLev = kHi - kLo + 1
                0412 
9c019881ee Jean*0413 C Assign a free unit number as the I/O channel for this routine
                0414       CALL MDSFINDUNIT( dUnit, myThid )
                0415 
                0416 C Check first for global file with simple name (ie. fName)
                0417       dataFName = fName
                0418       INQUIRE( file=dataFName, exist=exst )
                0419       IF (exst) THEN
ae605e558b Jean*0420        IF ( debugLevel .GE. debLevB ) THEN
9c019881ee Jean*0421         WRITE(msgBuf,'(A,A)')
                0422      &   ' MDS_READ_SEC_YZ: opening global file: ',dataFName(1:IL)
                0423         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0424      &                      SQUEEZE_RIGHT, myThid )
                0425        ENDIF
                0426        globalFile = .TRUE.
                0427       ENDIF
                0428 
                0429 C If negative check for global file with MDS name (ie. fName.data)
                0430       IF (.NOT. globalFile) THEN
                0431        WRITE(dataFName,'(2A)') fName(1:IL),'.data'
                0432        INQUIRE( file=dataFName, exist=exst )
                0433        IF (exst) THEN
ae605e558b Jean*0434         IF ( debugLevel .GE. debLevB ) THEN
9c019881ee Jean*0435          WRITE(msgBuf,'(A,A)')
                0436      &    ' MDS_READ_SEC_YZ: opening global file: ',dataFName(1:IL+5)
                0437          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0438      &                       SQUEEZE_RIGHT, myThid )
                0439         ENDIF
                0440         globalFile = .TRUE.
                0441        ENDIF
                0442       ENDIF
                0443 
                0444 C If we are reading from a global file then we open it here
                0445       IF (globalFile) THEN
                0446        length_of_rec = MDS_RECLEN( filePrec, sNy, myThid )
3d93c0a01e Ou W*0447        OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
9c019881ee Jean*0448      &       access='direct', recl=length_of_rec )
                0449        fileIsOpen=.TRUE.
                0450       ENDIF
                0451 
                0452 C Loop over all tiles
                0453       DO bj=1,nSy
                0454        DO bi=1,nSx
                0455 C If we are reading from a tiled MDS file then we open each one here
                0456         IF (.NOT. globalFile) THEN
                0457          iG=bi+(myXGlobalLo-1)/sNx
                0458          jG=bj+(myYGlobalLo-1)/sNy
                0459          WRITE(dataFName,'(2A,I3.3,A,I3.3,A)')
                0460      &              pfName(1:pIL),'.',iG,'.',jG,'.data'
                0461          INQUIRE( file=dataFName, exist=exst )
                0462 C Of course, we only open the file IF the tile is "active"
                0463 C (This is a place-holder for the active/passive mechanism
                0464          IF (exst) THEN
ae605e558b Jean*0465           IF ( debugLevel .GE. debLevB ) THEN
9c019881ee Jean*0466            WRITE(msgBuf,'(A,A)')
                0467      &      ' MDS_READ_SEC_YZ: opening file: ',dataFName(1:pIL+13)
                0468            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0469      &                         SQUEEZE_RIGHT, myThid )
                0470           ENDIF
                0471           length_of_rec = MDS_RECLEN( filePrec, sNy, myThid )
3d93c0a01e Ou W*0472           OPEN( dUnit, file=dataFName, status='old', _READONLY_ACTION
9c019881ee Jean*0473      &          access='direct', recl=length_of_rec )
                0474           fileIsOpen=.TRUE.
                0475          ELSE
                0476           fileIsOpen=.FALSE.
                0477           WRITE(msgBuf,'(4A)') ' MDS_READ_SEC_YZ: filename: ',
                0478      &             fName(1:IL),' , ', dataFName(1:pIL+13)
                0479           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0480      &                        SQUEEZE_RIGHT, myThid )
                0481           WRITE(msgBuf,'(A)')
                0482      &      ' MDS_READ_SEC_YZ: Files DO not exist'
                0483           CALL PRINT_ERROR( msgBuf, myThid )
                0484           STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ'
                0485          ENDIF
                0486         ENDIF
                0487 
                0488         IF (fileIsOpen) THEN
87c5bcbdbd Oliv*0489 #ifdef ALLOW_EXCH2
                0490 C layout of global y-z section files is "yStack"
                0491          tN = W2_myTileList(bi,bj)
                0492          tGy = exch2_tyYStackLo(tN)
                0493          tNy = exch2_tNy(tN)
                0494 #endif /* ALLOW_EXCH2 */
57622776fd Jean*0495          DO k=1,nLev
                0496            kL = k + kLo - 1
9c019881ee Jean*0497            IF (globalFile) THEN
87c5bcbdbd Oliv*0498 #ifdef ALLOW_EXCH2
                0499 C record length is sNy==tNy
                0500             irec = 1 + ( tGy-1
57622776fd Jean*0501      &                   + ( k-1 + (irecord-1)*nLev )*exch2_yStack_Ny
87c5bcbdbd Oliv*0502      &                 )/tNy
                0503 #else /* ALLOW_EXCH2 */
9c019881ee Jean*0504             iG = (myXGlobalLo-1)/sNx + (bi-1)
                0505             jG = myYGlobalLo-1 + (bj-1)*sNy
57622776fd Jean*0506             irec = 1 + INT(jG/sNy) + nSy*nPy*(k-1)
                0507      &           + nSy*nPy*nLev*(irecord-1)
87c5bcbdbd Oliv*0508 #endif /* ALLOW_EXCH2 */
9c019881ee Jean*0509            ELSE
                0510             iG = 0
                0511             jG = 0
57622776fd Jean*0512             irec = k + nLev*(irecord-1)
9c019881ee Jean*0513            ENDIF
                0514            IF (filePrec .EQ. precFloat32) THEN
                0515             READ(dUnit,rec=irec) r4seg
                0516 #ifdef _BYTESWAPIO
                0517             CALL MDS_BYTESWAPR4(sNy,r4seg)
                0518 #endif
                0519             IF (arrType .EQ. 'RS') THEN
57622776fd Jean*0520              CALL MDS_SEG4toRS_2D( sNy,OLy,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0521      &                             r4seg,fldRS )
                0522             ELSEIF (arrType .EQ. 'RL') THEN
57622776fd Jean*0523              CALL MDS_SEG4toRL_2D( sNy,OLy,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0524      &                             r4seg,fldRL )
                0525             ELSE
                0526              WRITE(msgBuf,'(A)')
                0527      &         ' MDS_READ_SEC_YZ: illegal value for arrType'
                0528              CALL PRINT_ERROR( msgBuf, myThid )
                0529              STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ'
                0530             ENDIF
                0531            ELSEIF (filePrec .EQ. precFloat64) THEN
                0532             READ(dUnit,rec=irec) r8seg
                0533 #ifdef _BYTESWAPIO
                0534             CALL MDS_BYTESWAPR8( sNy, r8seg )
                0535 #endif
                0536             IF (arrType .EQ. 'RS') THEN
57622776fd Jean*0537              CALL MDS_SEG8toRS_2D( sNy,OLy,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0538      &                             r8seg,fldRS )
                0539             ELSEIF (arrType .EQ. 'RL') THEN
57622776fd Jean*0540              CALL MDS_SEG8toRL_2D( sNy,OLy,kSize,bi,bj,kL,.TRUE.,
9c019881ee Jean*0541      &                             r8seg,fldRL )
                0542             ELSE
                0543              WRITE(msgBuf,'(A)')
                0544      &         ' MDS_READ_SEC_YZ: illegal value for arrType'
                0545              CALL PRINT_ERROR( msgBuf, myThid )
                0546              STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ'
                0547             ENDIF
                0548            ELSE
                0549             WRITE(msgBuf,'(A)')
                0550      &        ' MDS_READ_SEC_YZ: illegal value for filePrec'
                0551             CALL PRINT_ERROR( msgBuf, myThid )
                0552             STOP 'ABNORMAL END: S/R MDS_READ_SEC_YZ'
                0553            ENDIF
                0554 C End of k loop
                0555          ENDDO
                0556          IF (.NOT. globalFile) THEN
                0557           CLOSE( dUnit )
                0558           fileIsOpen = .FALSE.
                0559          ENDIF
                0560         ENDIF
                0561 C End of bi,bj loops
                0562        ENDDO
                0563       ENDDO
                0564 
                0565 C If global file was opened then close it
                0566       IF (fileIsOpen .AND. globalFile) THEN
                0567        CLOSE( dUnit )
                0568        fileIsOpen = .FALSE.
                0569       ENDIF
                0570 
                0571       _END_MASTER( myThid )
                0572 
                0573 C     ------------------------------------------------------------------
                0574       RETURN
                0575       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!