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
5b5f0da164 Jean*0001 #include "MDSIO_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C !ROUTINE: MDS_READVEC_LOC
                0005 C !INTERFACE:
                0006       SUBROUTINE MDS_READVEC_LOC(
                0007      I   fName,
                0008      I   filePrec,
                0009      U   ioUnit,
                0010      I   arrType,
                0011      I   nSize,
                0012      I   fldRL, fldRS,
                0013      I   bi, bj,
                0014      I   iRec,
                0015      I   myThid )
                0016 
                0017 C !DESCRIPTION:
                0018 C Arguments:
                0019 C
                0020 C fName    string  :: base name for file to read
                0021 C filePrec integer :: number of bits per word in file (32 or 64)
                0022 C ioUnit   integer :: fortran file IO unit
                0023 C nSize    integer :: number of elements of input array "fldRL/RS" to read
                0024 C arrType  char(2) :: which array (fldRL/RS) to read, either "RL" or "RS"
                0025 C fldRL    ( RL )  :: array to read if arrType="RL", fldRL(nSize)
                0026 C fldRS    ( RS )  :: array to read if arrType="RS", fldRS(nSize)
                0027 C bi,bj    integer :: tile indices (if tiled array) or 0,0 if not a tiled array
                0028 C iRec     integer :: record number to read
                0029 C myThid   integer :: my Thread Id number
                0030 C
                0031 C MDS_READVEC_LOC : reads a vector (local to tile bi,bj) from binary file:
                0032 C according to ioUnit:
                0033 C  ioUnit > 0 : assume file "ioUnit" is open, and read from it.
                0034 C  ioUnit = 0 : open file, read and close the file (return ioUnit=0).
                0035 C  ioUnit =-1 : open file, read and leave it open (return IO unit in ioUnit)
                0036 C  ioUnit =-2 : same as -1 except keep ioUnit=-2 (no stop) if missing file
                0037 C if bi=bj=0, MDS_READVEC_LOC first check if the file "fName" exists,
                0038 C  then if the file "fName.data" exists, and read from the 1rst found.
                0039 C if bi,bj >0, read from MDS tiled files of the form "fName.xxx.yyy.data"
                0040 C The precision of the file is described by filePrec, set either
                0041 C  to floatPrec32 or floatPrec64.
                0042 C iRec is the record number to read and must be >=1.
                0043 
                0044 C !USES:
                0045       IMPLICIT NONE
                0046 
                0047 C Global variables / common blocks
                0048 #include "SIZE.h"
                0049 #include "EEPARAMS.h"
                0050 #include "PARAMS.h"
63bf71414d Jean*0051 #ifdef ALLOW_FIZHI
                0052 # include "fizhi_SIZE.h"
                0053 #endif /* ALLOW_FIZHI */
1a7eba5cb1 Jean*0054 #include "MDSIO_BUFF_3D.h"
5b5f0da164 Jean*0055 
                0056 C !INPUT/OUTPUT PARAMETERS:
                0057       CHARACTER*(*) fName
                0058       INTEGER ioUnit
                0059       INTEGER filePrec
                0060       CHARACTER*(2) arrType
                0061       INTEGER nSize
                0062       _RL     fldRL(*)
                0063       _RS     fldRS(*)
                0064       INTEGER bi,bj
                0065       INTEGER iRec
                0066       INTEGER myThid
                0067 
                0068 C !FUNCTIONS:
                0069       INTEGER ILNBLNK
                0070       INTEGER MDS_RECLEN
                0071       EXTERNAL ILNBLNK
                0072       EXTERNAL MDS_RECLEN
                0073 
                0074 C !LOCAL VARIABLES:
                0075       CHARACTER*(MAX_LEN_FNAM) dataFname, pfName
                0076       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0077       LOGICAL exst
                0078       LOGICAL fileIsOpen
                0079       INTEGER iG,jG,dUnit,IL,pIL,iLfn
                0080       INTEGER length_of_rec
1a7eba5cb1 Jean*0081       INTEGER buffSize
5b5f0da164 Jean*0082 CEOP
                0083 
                0084 C---  Only DO I/O IF I am the master thread
                0085       _BEGIN_MASTER( myThid )
                0086 
                0087 C--   Assume nothing
                0088       fileIsOpen = .FALSE.
                0089       IL  = ILNBLNK( fName )
                0090 
                0091 C--   Record number must be >= 1
                0092       IF ( iRec.LT.1 ) THEN
                0093          WRITE(msgBuf,'(A,I9)')
                0094      &     ' MDS_READVEC_LOC: argument iRec = ',iRec
                0095          CALL PRINT_ERROR( msgBuf, myThid )
                0096          WRITE(msgBuf,'(A)')
                0097      &    ' MDS_READVEC_LOC: invalid value for iRec'
                0098          CALL PRINT_ERROR( msgBuf, myThid )
                0099          STOP 'ABNORMAL END: S/R MDS_READVEC_LOC'
                0100       ENDIF
                0101 
                0102 C--   Check buffer size
1a7eba5cb1 Jean*0103       buffSize = sNx*sNy*size3dBuf*nSx*nSy
                0104       IF ( nSize.GT.buffSize ) THEN
5b5f0da164 Jean*0105          WRITE(msgBuf,'(3A)')
                0106      &    ' MDS_READVEC_LOC: reading from file "', fName(1:IL), '":'
                0107          CALL PRINT_ERROR( msgBuf, myThid )
                0108          WRITE(msgBuf,'(A,I9)')
                0109      &     ' MDS_READVEC_LOC: dim of array to read=', nSize
                0110          CALL PRINT_ERROR( msgBuf, myThid )
                0111          WRITE(msgBuf,'(A,I9)')
1a7eba5cb1 Jean*0112      &     ' MDS_READVEC_LOC: exceeds buffer size=', buffSize
                0113          CALL PRINT_ERROR( msgBuf, myThid )
                0114          WRITE(msgBuf,'(A)')
                0115      &    ' increase "size3dBuf" in "MDSIO_BUFF_3D.h" and recompile'
5b5f0da164 Jean*0116          CALL PRINT_ERROR( msgBuf, myThid )
                0117          STOP 'ABNORMAL END: S/R MDS_READVEC_LOC'
                0118       ENDIF
                0119 
                0120       IF ( ioUnit.GT.0 ) THEN
                0121 C--   Assume file Unit is already open with correct Rec-Length & Precision
                0122          fileIsOpen = .TRUE.
                0123          dUnit = ioUnit
7a6cbf5d88 Jean*0124       ELSEIF ( ioUnit.GE.-2 ) THEN
5b5f0da164 Jean*0125 C--   Need to open file IO unit with File-name, Rec-Length & Precision
                0126 
                0127 C-    Assign special directory
                0128         IF ( mdsioLocalDir .NE. ' ' ) THEN
                0129           pIL = ILNBLNK( mdsioLocalDir )
                0130           WRITE(pFname,'(2A)') mdsioLocalDir(1:pIL), fName(1:IL)
                0131           pIL = IL + pIL
                0132         ELSE
                0133           WRITE(pFname,'(A)') fName(1:IL)
                0134           pIL = IL
                0135         ENDIF
                0136 
                0137 C-    Assign a free unit number as the I/O channel for this routine
                0138         CALL MDSFINDUNIT( dUnit, myThid )
                0139 
                0140 C--   Set the file Name:
                0141         IF ( bi.EQ.0 .AND. bj.EQ.0 ) THEN
                0142 C-    Check first for global file with simple name (ie. fName)
                0143           WRITE(dataFname,'(2A)') fName(1:IL)
                0144           iLfn = IL
                0145           INQUIRE( file=dataFname, exist=exst )
                0146 c         IF (exst) THEN
                0147 c           write(0,*) 'found file: ',dataFname(1:iLfn)
                0148 c         ENDIF
                0149           IF ( .NOT.exst ) THEN
                0150 C-    Check for global file with ".data" suffix
                0151             WRITE(dataFname,'(2A)') fName(1:IL),'.data'
                0152             iLfn = IL+5
                0153             INQUIRE( file=dataFname, exist=exst )
                0154 c           IF (exst) THEN
                0155 c            write(0,*) 'found file: ',dataFname(1:iLfn)
                0156 c           ENDIF
                0157           ENDIF
                0158         ELSE
                0159 C-    We are reading a tiled array (bi>0,bj>0):
                0160           iG=bi+(myXGlobalLo-1)/sNx
                0161           jG=bj+(myYGlobalLo-1)/sNy
                0162           WRITE(dataFname,'(2A,I3.3,A,I3.3,A)')
                0163      &          pfName(1:pIL),'.',iG,'.',jG,'.data'
                0164           iLfn= pIL+8+5
                0165           INQUIRE( file=dataFname, exist=exst )
                0166 c         IF (exst) THEN
                0167 c          write(0,*) 'found file: ',dataFname(1:iLfn)
                0168 c         ENDIF
                0169         ENDIF
                0170 C--   Open the file:
                0171         IF ( exst ) THEN
                0172           IF ( debugLevel.GE.debLevB ) THEN
                0173             WRITE(msgBuf,'(2A)')
                0174      &      ' MDS_READVEC_LOC: open file: ',dataFname(1:iLfn)
                0175             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
7a6cbf5d88 Jean*0176      &                          SQUEEZE_RIGHT, myThid )
5b5f0da164 Jean*0177           ENDIF
                0178           length_of_rec = MDS_RECLEN( filePrec, nSize, myThid )
                0179           OPEN( dUnit, file=dataFname, status=_OLD_STATUS,
3d93c0a01e Ou W*0180      &          _READONLY_ACTION access='direct', recl=length_of_rec )
5b5f0da164 Jean*0181           fileIsOpen=.TRUE.
                0182         ELSE
                0183           fileIsOpen=.FALSE.
7a6cbf5d88 Jean*0184           WRITE(msgBuf,'(3A)')
5b5f0da164 Jean*0185      &     'S/R MDS_READVEC_LOC: file=',dataFname(1:iLfn),' not found'
7a6cbf5d88 Jean*0186           IF ( ioUnit.GE.-1 ) THEN
                0187            CALL PRINT_ERROR( msgBuf, myThid )
5b5f0da164 Jean*0188            STOP 'ABNORMAL END: S/R MDS_READVEC_LOC'
7a6cbf5d88 Jean*0189           ELSEIF ( debugLevel.GE.debLevA ) THEN
                0190            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0191      &                         SQUEEZE_RIGHT, myThid )
5b5f0da164 Jean*0192           ENDIF
                0193         ENDIF
7a6cbf5d88 Jean*0194       ELSE
                0195          WRITE(msgBuf,'(A,I9,A)')  ' MDS_READVEC_LOC:',
                0196      &         ioUnit, ' = invalid value for ioUnit argument'
                0197          CALL PRINT_ERROR( msgBuf, myThid )
                0198          STOP 'ABNORMAL END: S/R MDS_READVEC_LOC'
5b5f0da164 Jean*0199 C--   End if block: File Unit is already open / Need to open it
                0200       ENDIF
                0201 
                0202 C--   Read from file
                0203       IF ( fileIsOpen ) THEN
                0204          IF ( arrType.EQ.'RS' ) THEN
1a7eba5cb1 Jean*0205             CALL MDS_RD_REC_RS( fldRS, shared3dBuf_r4, shared3dBuf_r8,
5b5f0da164 Jean*0206      I                          filePrec, dUnit, iRec, nSize, myThid )
                0207          ELSEIF ( arrType.EQ.'RL' ) THEN
1a7eba5cb1 Jean*0208             CALL MDS_RD_REC_RL( fldRL, shared3dBuf_r4, shared3dBuf_r8,
5b5f0da164 Jean*0209      I                          filePrec, dUnit, iRec, nSize, myThid )
                0210          ELSE
                0211             WRITE(msgBuf,'(A)')
                0212      &          ' MDS_READVEC_LOC: illegal value for arrType'
                0213             CALL PRINT_ERROR( msgBuf, myThid )
                0214             STOP 'ABNORMAL END: S/R MDS_READVEC_LOC'
                0215          ENDIF
                0216       ENDIF
                0217 
                0218 C--   Close file
                0219       IF ( fileIsOpen ) THEN
                0220         IF ( ioUnit.EQ.-2 .OR. ioUnit.EQ.-1 ) THEN
                0221           ioUnit = dUnit
7a6cbf5d88 Jean*0222         ELSEIF ( ioUnit.EQ.0 ) THEN
5b5f0da164 Jean*0223           CLOSE( dUnit )
                0224           fileIsOpen = .FALSE.
                0225         ENDIF
                0226       ENDIF
                0227 
                0228       _END_MASTER( myThid )
                0229 
                0230       RETURN
                0231       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!