pkg/mdsio/mdsio_check4file.F

121c737528 Jean*0001 #include "MDSIO_OPTIONS.h"
5471ba5671 Jean*0002
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP
                0005 C     !ROUTINE: MDS_CHECK4FILE
                0006
                0007 C     !INTERFACE:
                0008       SUBROUTINE MDS_CHECK4FILE(
                0009      I                           filePfx, fileSfx, prtID,
                0010      O                           fileName, fileExist,
121c737528 Jean*0011      I                           useCurrentDir,
5471ba5671 Jean*0012      I                           myThid )
                0013
                0014 C     !DESCRIPTION:
                0015 C     Check if file exist :
                0016 C     1rst check prefix alone, then prefix+suffix ; then prefix.tileNb+suffix
                0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020 C     === Global variables ===
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
121c737528 Jean*0023 #include "PARAMS.h"
5471ba5671 Jean*0024
                0025 C     !INPUT/OUTPUT PARAMETERS:
                0026 C     == Routine arguments ==
121c737528 Jean*0027 C useCurrentDir :: always search for file in the current directory
                0028 C                  (even if "mdsioLocalDir" is set)
5471ba5671 Jean*0029 C     filePfx   :: file name prefix
                0030 C     fileSfx   :: file name suffix
                0031 C     prtID     :: print Identificator (in case file is not found)
                0032 C     fileName  :: file which has been found
                0033 C     fileExist :: True when file has been found
                0034 C     myThid    :: my Thread Id number
121c737528 Jean*0035       LOGICAL useCurrentDir
5471ba5671 Jean*0036       CHARACTER*(*) filePfx, fileSfx, prtID
                0037       CHARACTER*(*) fileName
                0038       LOGICAL fileExist
                0039       INTEGER myThid
                0040
                0041 C     !FUNCTIONS:
                0042       INTEGER  IFNBLNK, ILNBLNK
                0043       EXTERNAL IFNBLNK, ILNBLNK
                0044
                0045 C     !LOCAL VARIABLES:
                0046 C     == Local variables in common block ==
                0047       LOGICAL shareExist
                0048       COMMON / LOCAL_MDS_CHECK4FILE / shareExist
                0049 C     == Local variables ==
                0050       CHARACTER*(MAX_LEN_MBUF) msgBuf, msgPfx
                0051       INTEGER iG, jG
121c737528 Jean*0052       INTEGER lp, ip, is, iL, i, ioUnit
5471ba5671 Jean*0053 CEOP
                0054
                0055       ioUnit = errorMessageUnit
                0056       fileName = ' '
                0057
                0058 C--   First check if fileName is long enough
121c737528 Jean*0059       lp = ILNBLNK( mdsioLocalDir )
                0060       IF ( useCurrentDir ) lp = 0
5471ba5671 Jean*0061       ip = ILNBLNK(filePfx)
                0062       is = ILNBLNK(fileSfx)
                0063       IF ( ip.EQ.0 ) is = 0
                0064        i  = LEN(fileName)
121c737528 Jean*0065       IF ( i .LT. lp+ip+is+8 ) THEN
5471ba5671 Jean*0066         WRITE(msgBuf,'(A,I6,A,I6)')
                0067      &    'MDS_CHECK4FILE: file name length=', i,
121c737528 Jean*0068      &    ' too small <', lp+ip+is+8
5471ba5671 Jean*0069         CALL PRINT_ERROR( msgBuf, myThid )
                0070         STOP 'ABNORMAL END: S/R MDS_CHECK4FILE'
                0071       ENDIF
                0072
                0073       _BARRIER
                0074       _BEGIN_MASTER( myThid )
                0075
                0076 C--   Check if file with various suffix exist
                0077       fileExist = .FALSE.
                0078       IF ( .NOT.fileExist .AND. ip.GE.1 ) THEN
                0079 C-    look for file = {filePfx}
                0080         WRITE(fileName,'(A)') filePfx(1:ip)
                0081         INQUIRE( FILE=fileName, EXIST=fileExist )
                0082       ENDIF
                0083       IF ( .NOT.fileExist .AND. is.GE.1 ) THEN
                0084 C-    look for file = {filePfx}{fileSfx}
                0085         WRITE(fileName,'(2A)') filePfx(1:ip), fileSfx(1:is)
                0086         INQUIRE( FILE=fileName, EXIST=fileExist )
                0087       ENDIF
                0088       IF ( .NOT.fileExist .AND. is.GE.1 ) THEN
                0089 C-    look for file = {filePfx}'.{iG}.{jG}'{fileSfx}
                0090         iG = 1+(myXGlobalLo-1)/sNx
                0091         jG = 1+(myYGlobalLo-1)/sNy
121c737528 Jean*0092         IF ( lp.EQ.0 ) THEN
                0093           WRITE(fileName,'(2A,I3.3,A,I3.3,A)')
                0094      &                  filePfx(1:ip), '.', iG, '.', jG, fileSfx(1:is)
                0095         ELSE
                0096           WRITE(fileName,'(3A,I3.3,A,I3.3,A)') mdsioLocalDir(1:lp),
                0097      &                  filePfx(1:ip), '.', iG, '.', jG, fileSfx(1:is)
                0098         ENDIF
5471ba5671 Jean*0099         INQUIRE( FILE=fileName, EXIST=fileExist )
                0100       ENDIF
                0101       IF ( .NOT.fileExist .AND. is.GE.1 ) THEN
                0102 C-    look for file = {filePfx}'.001.001'{fileSfx}
121c737528 Jean*0103         IF ( lp.EQ.0 ) THEN
                0104           WRITE(fileName,'(3A)')
                0105      &                  filePfx(1:ip), '.001.001', fileSfx(1:is)
                0106         ELSE
                0107           WRITE(fileName,'(4A)') mdsioLocalDir(1:lp),
                0108      &                  filePfx(1:ip), '.001.001', fileSfx(1:is)
                0109         ENDIF
5471ba5671 Jean*0110         INQUIRE( FILE=fileName, EXIST=fileExist )
                0111       ENDIF
                0112
                0113       IF ( .NOT.fileExist ) THEN
                0114         ip = MAX(ILNBLNK(filePfx),1)
                0115         is = MAX(is,1)
                0116         i  = MAX(ILNBLNK(fileName),1)
                0117         iL = ILNBLNK(prtID)
                0118         IF ( iL.GE.1 ) THEN
                0119           WRITE(msgPfx,'(2A)') 'WARNING >> ',prtID(1:iL)
                0120         ELSE
                0121           WRITE(msgPfx,'(2A)') 'WARNING >> MDS_CHECK4FILE'
                0122         ENDIF
                0123         iL = ILNBLNK(msgPfx)
                0124         WRITE(msgBuf,'(7A)') msgPfx(1:iL), ': file: ',
                0125      &       filePfx(1:ip), ' , ', fileSfx(1:is), ' , ', fileName(1:i)
                0126         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0127         WRITE(msgBuf,'(2A)') msgPfx(1:iL), ': Files DO not exist'
                0128         CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid )
                0129         fileName = ' '
                0130       ENDIF
                0131
                0132       shareExist = fileExist
                0133
                0134       _END_MASTER( myThid )
                0135       _BARRIER
                0136
                0137       fileExist = shareExist
                0138
                0139       RETURN
                0140       END