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
11aeef3734 Jean*0001 #include "MDSIO_OPTIONS.h"
                0002 
                0003 CBOP
                0004 C     !ROUTINE: MDS_READ_META
                0005 C     !INTERFACE:
                0006       SUBROUTINE MDS_READ_META(
                0007      I               fileName,
                0008      O               simulName,
                0009      O               titleLine,
                0010      O               filePrec,
                0011      U               nDims,   nFlds,   nTimRec,
                0012      O               dimList, fldList, timList,
8a1d1934ce Jean*0013      O               misVal, nRecords, fileIter,
11aeef3734 Jean*0014      I               useCurrentDir,
                0015      I               myThid )
                0016 
                0017 C     !DESCRIPTION: \bv
                0018 C     *==========================================================*
                0019 C     | S/R MDS_READ_META
                0020 C     | o Read the content of 1 meta file
                0021 C     *==========================================================*
                0022 C     \ev
                0023 
                0024 C     !USES:
                0025       IMPLICIT NONE
                0026 
                0027 C     == Global variables / common blocks
                0028 #include "SIZE.h"
                0029 #include "EEPARAMS.h"
                0030 #include "PARAMS.h"
                0031 
                0032 C     !INPUT PARAMETERS:
                0033 C     fileName  (string ) :: prefix of meta-file name
                0034 C     nDims     (integer) :: max size of array dimList (or =0 if not reading dimList)
                0035 C     nFlds     (integer) :: max size of array fldList (or =0 if not reading fldList)
                0036 C     nTimRec   (integer) :: max size of array timList (or =0 if not reading timList)
                0037 C     useCurrentDir(logic):: always read from the current directory (even if
                0038 C                            "mdsioLocalDir" is set)
                0039 C     myThid    (integer) :: my Thread Id number
                0040 C
                0041 C     !OUTPUT PARAMETERS:
                0042 C     simulName (string)  :: name of simulation (recorded in file)
                0043 C     titleLine (string)  :: title or any descriptive comments (in file)
                0044 C     filePrec  (integer) :: number of bits per word in data-file (32 or 64)
                0045 C     nDims     (integer) :: number of dimensions
                0046 C     dimList   (integer) :: array of dimensions
                0047 cC    map2gl    (integer) :: used for mapping tiled file to global file
                0048 C     nFlds     (integer) :: number of fields in "fldList"
                0049 C     fldList   (string)  :: list of fields (names) stored in file
                0050 C     nTimRec   (integer) :: number of time-specification in "timList"
                0051 C     timList   (real)    :: array of time-specifications (recorded in file)
8a1d1934ce Jean*0052 C     misVal    (real)    :: missing value
11aeef3734 Jean*0053 C     nRecords  (integer) :: number of records
                0054 C     fileIter  (integer) :: time-step number (recorded in file)
                0055 C
                0056       CHARACTER*(*) fileName
                0057       CHARACTER*(*) simulName
                0058       CHARACTER*(*) titleLine
                0059       INTEGER filePrec
                0060       INTEGER nDims
                0061       INTEGER dimList(3,*)
                0062 c     INTEGER map2gl(2)
                0063       INTEGER nFlds
                0064       CHARACTER*(8) fldList(*)
                0065       INTEGER nTimRec
                0066       _RL     timList(*)
8a1d1934ce Jean*0067       _RL     misVal
11aeef3734 Jean*0068       INTEGER nRecords
                0069       INTEGER fileIter
                0070       LOGICAL useCurrentDir
                0071       INTEGER myThid
                0072 CEOP
                0073 
                0074 C     !FUNCTIONS
700a36f4de Jean*0075       INTEGER  ILNBLNK
                0076       EXTERNAL ILNBLNK
11aeef3734 Jean*0077 
                0078 C     !LOCAL VARIABLES:
700a36f4de Jean*0079 C     i, j, ii    :: loop indices
afdbe20224 Jean*0080 C     iG,jG       :: global tile indices
11aeef3734 Jean*0081 C     iL,pL,iLm   :: length of character strings (temp. variables)
                0082 C     nDimFil     :: number of dimensions (in meta file)
                0083 C     nFldFil     :: number of fields in "fldList" (in meta file)
                0084 C     nTimFil     :: number of time-specification in "timList" (meta file)
700a36f4de Jean*0085       INTEGER i,j,ii
afdbe20224 Jean*0086       INTEGER iG,jG
                0087       INTEGER iL,pL,iLm
11aeef3734 Jean*0088       INTEGER mUnit, errIO
                0089       INTEGER nDimFil, nFldFil, nTimFil
                0090       LOGICAL fileExist, globalFile
                0091       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0092       CHARACTER*(MAX_LEN_MBUF) lineBuf
                0093       CHARACTER*(MAX_LEN_FNAM) mFileName, pfName
                0094 
                0095 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0096 
                0097 C--   Initialise output arguments
                0098       simulName = ' '
                0099       titleLine = ' '
                0100       filePrec  = 0
                0101       nRecords  = 0
                0102       fileIter  = 0
                0103 c     map2gl(1) = 0
                0104 c     map2gl(2) = 1
afdbe20224 Jean*0105       DO j=1,nDims
                0106        DO i=1,3
                0107         dimList(i,j) = 0
11aeef3734 Jean*0108        ENDDO
                0109       ENDDO
                0110       DO i=1,nFlds
                0111        fldList(i)= ' '
                0112       ENDDO
                0113       DO i=1,nTimRec
                0114        timList(i) = 0.
                0115       ENDDO
8a1d1934ce Jean*0116       misVal = oneRL
11aeef3734 Jean*0117 C--   Initialise Temp Var.
                0118       fileExist  = .FALSE.
                0119       globalFile = .FALSE.
                0120       nDimFil   = 0
                0121       nFldFil   = 0
                0122       nTimFil   = 0
                0123 
                0124 C--   Only Master thread check for file, open & read ; others will
                0125 C     return null argument ; sharing output needs to be done outside
                0126 C     this S/R, using, e.g., common block (+ Master_thread + Barrier)
                0127       _BEGIN_MASTER( myThid )
                0128 
                0129 C     Assign special directory
                0130       iL = ILNBLNK(fileName)
                0131       pL = ILNBLNK( mdsioLocalDir )
                0132       IF ( useCurrentDir .OR. pL.EQ.0 ) THEN
                0133         pfName = fileName
                0134       ELSE
                0135         WRITE(pfName,'(2A)') mdsioLocalDir(1:pL), fileName(1:iL)
                0136       ENDIF
                0137       pL = ILNBLNK( pfName )
                0138 
                0139 C--   Search for meta file:
                0140 C-    look for meta-file = {fileName}
                0141       mFileName = fileName(1:iL)
                0142       iLm = iL
                0143 c     INQUIRE( FILE=mFileName, EXIST=fileExist )
                0144       IF ( .NOT.fileExist ) THEN
                0145 C-    look for meta-file = {fileName}'.meta'
                0146         WRITE(mFileName,'(2A)') fileName(1:iL), '.meta'
                0147         iLm = iL+5
                0148         INQUIRE( FILE=mFileName, EXIST=fileExist )
                0149       ENDIF
                0150       IF ( fileExist ) THEN
                0151         globalFile = .TRUE.
                0152       ELSE
                0153 C-    look for meta-file = {fileName}'.{iG}.{jG}.meta'
                0154         iG = 1+(myXGlobalLo-1)/sNx
                0155         jG = 1+(myYGlobalLo-1)/sNy
                0156         WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
                0157      &             pfName(1:pL),'.',iG,'.',jG,'.meta'
                0158         iLm = pL+8+5
                0159         INQUIRE( FILE=mFileName, EXIST=fileExist )
                0160       ENDIF
                0161       IF ( .NOT.fileExist ) THEN
                0162 C-    look for meta-file = {fileName}'.001.001.meta'
                0163         WRITE(mFileName,'(2A,I3.3,A,I3.3,A)')
                0164      &             pfName(1:pL),'.',1,'.',1,'.meta'
                0165         iLm = pL+8+5
                0166         INQUIRE( FILE=mFileName, EXIST=fileExist )
                0167       ENDIF
                0168       IF ( .NOT.fileExist ) THEN
                0169         WRITE(msgBuf,'(4A)') 'WARNING >> MDS_READ_META: file: ',
                0170      &          fileName(1:iL), '.meta , ', mFileName(1:iLm)
                0171 c    &               fileName(1:iL), ' , ', mFileName(1:iLm)
                0172         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0173      &                        SQUEEZE_RIGHT , myThid )
                0174         WRITE(msgBuf,'(A)')
                0175      &           'WARNING >> MDS_READ_META: Files DO not exist'
                0176         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0177      &                        SQUEEZE_RIGHT , myThid )
                0178         nFldFil = -1
                0179       ELSE
                0180 
                0181 C--   File exist
ae605e558b Jean*0182         IF ( debugLevel .GE. debLevB ) THEN
11aeef3734 Jean*0183           WRITE(msgBuf,'(2A)') ' MDS_READ_META: opening file: ',
                0184      &                        mFileName(1:iLm)
                0185           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0186      &                        SQUEEZE_RIGHT , myThid)
                0187         ENDIF
                0188 
                0189 C-    Assign a free unit number as the I/O channel for this subroutine
                0190         CALL MDSFINDUNIT( mUnit, myThid )
                0191 
                0192 C-    Open meta-file
3d93c0a01e Ou W*0193         OPEN( mUnit, FILE=mFileName, STATUS='old', _READONLY_ACTION
11aeef3734 Jean*0194      &        FORM='formatted', IOSTAT=errIO )
                0195 c       write(0,*) 'errIO=',errIO
                0196         IF ( errIO .NE. 0 ) THEN
                0197           WRITE(msgBuf,'(A,A)') 'MDS_READ_META: Unable to open file: ',
                0198      &                           mFileName(1:iLm)
                0199           CALL PRINT_ERROR( msgBuf , myThid )
                0200           STOP 'ABNORMAL END: S/R MDS_READ_META'
                0201         ENDIF
                0202 
                0203 C-    Read the meta file in the same way as S/R OPEN_COPY_DATA_FILE
                0204 C     (which seems to be works on many platforms):
                0205         DO WHILE ( .TRUE. )
                0206          READ( mUnit, FMT='(A)', END=1001 ) lineBuf
                0207 C--   Extract information from buffer: "lineBuf"
                0208          iL = ILNBLNK(lineBuf)
                0209 
                0210 C-    Read simulation name (stored in file)
                0211          IF ( iL.GE.22 .AND. lineBuf(1:14).EQ.' simulation = ' ) THEN
                0212           ii = LEN(simulName)
                0213 c         IF ( ii.LT.iL-21 )  print 'warning: truncate simulName'
                0214           ii = MIN(ii+17,iL-4)
                0215           simulName = lineBuf(18:ii)
                0216           iL = 0
                0217          ENDIF
                0218 
                0219 C-    Read the number of dimensions
                0220          IF ( nDimFil.EQ.0 .AND.
                0221      &        iL.GE.15 .AND. lineBuf(1:9).EQ.' nDims = ' ) THEN
                0222           READ(lineBuf(12:iL),'(I3)') nDimFil
                0223           IF ( nDimFil.GT.nDims .AND. nDims.GE.1 ) THEN
                0224             WRITE(msgBuf,'(2(A,I3),A)') ' MDS_READ_META: nDims=',
                0225      &                   nDimFil, ' too large ( >', nDims, ' )'
                0226             CALL PRINT_ERROR( msgBuf, myThid )
                0227             STOP 'ABNORMAL END: S/R MDS_READ_META'
                0228           ENDIF
                0229           iL = 0
                0230          ENDIF
                0231 
                0232 C-    Read list of dimensions
                0233          IF ( nDims.GE.1 .AND. nDimFil.GE.1 .AND.
                0234      &        iL.GE.11 .AND. lineBuf(1:11).EQ.' dimList = ' ) THEN
                0235 C-    For each dimension, read the following:
                0236 C     1  global size  (ie. the size of the global dimension of all files)
                0237 C     2  global start (ie. the global position of the start of this file)
                0238 C     3  global end   (ie. the global position of the end   of this file)
afdbe20224 Jean*0239           DO j=1,nDimFil
                0240 C-    This is to accomodate with the 2 versions of meta file:
                0241            READ( mUnit, FMT='(A)', END=1001 ) lineBuf
700a36f4de Jean*0242            ii = ILNBLNK(lineBuf)
                0243            IF ( ii.LT.20 ) THEN
afdbe20224 Jean*0244 C     New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
079512f56f Jean*0245 C          small-size domain without starting blanks.
afdbe20224 Jean*0246             READ(lineBuf, FMT='(3(1X,I5))',    ERR=1002, END=1002 )
                0247      &                  (dimList(i,j),i=1,3)
700a36f4de Jean*0248            ELSEIF ( ii.LT.30 ) THEN
                0249 C     Old version (S/R MDSWRITEMETA, file mdsio_writemeta.F):
                0250 C          start each line with 10 blanks.
                0251             READ(lineBuf, FMT='(9X,3(1X,I5))', ERR=1002, END=1002 )
                0252      &                  (dimList(i,j),i=1,3)
079512f56f Jean*0253            ELSE
                0254 C     New version (S/R MDS_WRITE_META, file mdsio_write_meta.F):
                0255 C          large-size domain without starting blanks.
                0256             READ(lineBuf, FMT='(3(1X,I10))',   ERR=1002, END=1002 )
                0257      &                  (dimList(i,j),i=1,3)
afdbe20224 Jean*0258            ENDIF
11aeef3734 Jean*0259           ENDDO
                0260           READ(  mUnit, FMT='(A)', END=1001 ) lineBuf
                0261           iL = 0
                0262          ENDIF
                0263 
                0264 C-    only write if different from default:
                0265 c     IF ( map2gl(1).NE.0 .OR. map2gl(2).NE.1 ) THEN
                0266 c       WRITE(mUnit,'(1X,2(A,I5),A)') 'map2glob = [ ',
                0267 c    &                  map2gl(1),',',map2gl(2),' ];'
                0268 c     ENDIF
                0269 
                0270 C-    Read the precision of the file
                0271          IF ( iL.GE.20 .AND. lineBuf(1:12).EQ.' dataprec = ' ) THEN
                0272           IF (     lineBuf(16:22).EQ. 'float32' )  THEN
                0273             filePrec = precFloat32
                0274           ELSEIF ( lineBuf(16:22).EQ. 'float64' ) THEN
                0275             filePrec = precFloat64
                0276           ELSE
                0277             WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
                0278             CALL PRINT_ERROR( msgBuf, myThid )
                0279             CALL PRINT_ERROR(lineBuf, myThid )
                0280             STOP 'ABNORMAL END: S/R MDS_READ_META'
                0281           ENDIF
                0282           iL = 0
                0283          ENDIF
                0284 C-    Read (old format) precision of the file
                0285          IF ( filePrec.EQ.0 .AND.
                0286      &        iL.GE.18 .AND. lineBuf(1:10).EQ.' format = ' ) THEN
                0287           IF (     lineBuf(14:20).EQ. 'float32' )  THEN
                0288             filePrec = precFloat32
                0289           ELSEIF ( lineBuf(14:20).EQ. 'float64' ) THEN
                0290             filePrec = precFloat64
                0291           ELSE
                0292             WRITE(msgBuf,'(A)') ' MDS_READ_META: invalid dataprec'
                0293             CALL PRINT_ERROR( msgBuf, myThid )
                0294             CALL PRINT_ERROR(lineBuf, myThid )
                0295             STOP 'ABNORMAL END: S/R MDS_READ_META'
                0296           ENDIF
                0297           iL = 0
                0298          ENDIF
                0299 
                0300 C-    Read the number of records
                0301          IF ( nRecords.EQ.0 .AND.
                0302      &        iL.GE.20 .AND. lineBuf(1:12).EQ.' nrecords = ' ) THEN
66046ae6a1 Brun*0303           IF ( iL.GE.25 ) THEN
                0304             READ(lineBuf(15:iL),'(I10)') nRecords
                0305           ELSE
                0306             READ(lineBuf(15:iL),'(I5)') nRecords
                0307           ENDIF
11aeef3734 Jean*0308           iL = 0
                0309          ENDIF
                0310 
                0311 C-    Read recorded iteration number
                0312          IF ( fileIter.EQ.0 .AND. iL.GE.31 .AND.
                0313      &        lineBuf(1:18).EQ.' timeStepNumber = ' ) THEN
                0314           READ(lineBuf(21:iL),'(I10)') fileIter
                0315           iL = 0
                0316          ENDIF
                0317 
8a1d1934ce Jean*0318 C-    Read list of Time Intervals
11aeef3734 Jean*0319          IF ( nTimFil.EQ.0 .AND.
8a1d1934ce Jean*0320      &        iL.GE.38 .AND. lineBuf(1:16).EQ.' timeInterval = ' ) THEN
11aeef3734 Jean*0321 C note: format might change once we have a better idea of what will
                0322 C       be the time-information to write.
8a1d1934ce Jean*0323           nTimFil = INT((iL-17-3)/20)
11aeef3734 Jean*0324           IF ( nTimRec.GE.1 ) THEN
                0325             IF ( nTimFil.GT.nTimRec ) THEN
                0326              WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nTimRec=',
                0327      &                    nTimFil, ' too large ( >', nTimRec, ' )'
                0328              CALL PRINT_ERROR( msgBuf, myThid )
                0329              STOP 'ABNORMAL END: S/R MDS_READ_META'
                0330             ENDIF
8a1d1934ce Jean*0331             READ(lineBuf(18:iL-3),'(1P20E20.12)',ERR=1003)
11aeef3734 Jean*0332      &                            (timList(i),i=1,nTimFil)
                0333           ENDIF
                0334           iL = 0
8a1d1934ce Jean*0335          ENDIF
                0336 
                0337          IF ( iL.GE.8 .AND. lineBuf(1:4).EQ.' /* ' ) THEN
11aeef3734 Jean*0338           IF ( lineBuf(iL-2:iL).EQ.' */' ) THEN
                0339 C-    Read title or comments (ignored by rdmds)
                0340            ii = LEN(titleLine)
                0341 c          IF ( ii.LT.iL-7 )  print 'warning: truncate titleLine'
                0342            ii = MIN(ii+4,iL-3)
                0343            titleLine = lineBuf(5:ii)
                0344            iL = 0
                0345           ENDIF
                0346          ENDIF
                0347 
8a1d1934ce Jean*0348 C-    Read missing value
                0349          IF ( misVal.EQ.oneRL .AND. iL.GE.40 .AND.
                0350      &        lineBuf(1:16).EQ.' missingValue = ' ) THEN
                0351           READ(lineBuf(19:iL),'(1PE21.14)') misVal
                0352           iL = 0
                0353          ENDIF
                0354 
11aeef3734 Jean*0355 C-    Read number of Fields
                0356          IF ( nFldFil.EQ.0 .AND.
                0357      &        iL.GE.16 .AND. lineBuf(1:9).EQ.' nFlds = ' ) THEN
                0358           READ(lineBuf(12:iL),'(I4)') nFldFil
                0359           IF ( nFldFil.GT.nFlds .AND. nFlds.GE.1 ) THEN
                0360             WRITE(msgBuf,'(2(A,I6),A)') ' MDS_READ_META: nFlds=',
                0361      &                   nFldFil, ' too large ( >', nFlds, ' )'
                0362             CALL PRINT_ERROR( msgBuf, myThid )
                0363             STOP 'ABNORMAL END: S/R MDS_READ_META'
                0364           ENDIF
                0365           iL = 0
                0366          ENDIF
                0367 
                0368 C-    Read list of Fields
                0369          IF ( nFldFil.GE.1 .AND. nFlds.GE.1 .AND.
                0370      &        iL.GE.11 .AND. lineBuf(1:11).EQ.' fldList = ' ) THEN
afdbe20224 Jean*0371           DO j=1,nFldFil,20
11aeef3734 Jean*0372            READ( mUnit, FMT='(20(2X,A8,1X))', ERR=1004, END=1004 )
afdbe20224 Jean*0373      &          (fldList(i),i=j,MIN(nFldFil,j+19))
11aeef3734 Jean*0374           ENDDO
                0375           READ(  mUnit, FMT='(A)', END=1001 ) lineBuf
                0376           iL = 0
                0377          ENDIF
                0378 
                0379 C--   End of reading file line per line
                0380         ENDDO
                0381  1004   CONTINUE
                0382         WRITE(msgBuf,'(2(A,I4),A)')
                0383      &    ' MDS_READ_META: error reading Fields: nFlds=',
afdbe20224 Jean*0384      &     nFldFil, ' , j=', j
11aeef3734 Jean*0385         CALL PRINT_ERROR( msgBuf, myThid )
                0386         STOP 'ABNORMAL END: S/R MDS_READ_META'
                0387  1003   CONTINUE
                0388         WRITE(msgBuf,'(2(A,I4),A)')
8a1d1934ce Jean*0389      &    ' MDS_READ_META: error reading Time-Interval: nTimRec=',
11aeef3734 Jean*0390      &     nTimFil, ' , iL=', iL
                0391         CALL PRINT_ERROR( msgBuf, myThid )
                0392         CALL PRINT_ERROR(lineBuf, myThid )
                0393         STOP 'ABNORMAL END: S/R MDS_READ_META'
                0394  1002   CONTINUE
afdbe20224 Jean*0395         WRITE(msgBuf,'(3(A,I3),A)')
11aeef3734 Jean*0396      &    ' MDS_READ_META: error reading Dim-List: nDims=',
afdbe20224 Jean*0397      &     nDimFil, ' , j=', j, ' , ii=', ii
11aeef3734 Jean*0398         CALL PRINT_ERROR( msgBuf, myThid )
afdbe20224 Jean*0399         CALL PRINT_ERROR(lineBuf, myThid )
11aeef3734 Jean*0400         STOP 'ABNORMAL END: S/R MDS_READ_META'
                0401  1001   CONTINUE
                0402 
                0403 C-    Close meta-file
                0404         CLOSE(mUnit)
                0405 
                0406 C-    end if block: file exist
                0407       ENDIF
                0408 
                0409       _END_MASTER( myThid )
                0410 
                0411 C-    Update Arguments with values read from file
                0412       nDims   = nDimFil
                0413       nFlds   = nFldFil
                0414       nTimRec = nTimFil
                0415 
                0416 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0417 
                0418       RETURN
                0419       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!