| 1 |
C $Header: /u/gcmpack/MITgcm/eesupp/src/mds_check4file.F,v 1.1 2008/09/14 01:47:29 jmc Exp $ |
| 2 |
C $Name: $ |
| 3 |
|
| 4 |
#include "MDSIO_OPTIONS.h" |
| 5 |
|
| 6 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
| 7 |
CBOP |
| 8 |
C !ROUTINE: MDS_CHECK4FILE |
| 9 |
|
| 10 |
C !INTERFACE: |
| 11 |
SUBROUTINE MDS_CHECK4FILE( |
| 12 |
I filePfx, fileSfx, prtID, |
| 13 |
O fileName, fileExist, |
| 14 |
I useCurrentDir, |
| 15 |
I myThid ) |
| 16 |
|
| 17 |
C !DESCRIPTION: |
| 18 |
C Check if file exist : |
| 19 |
C 1rst check prefix alone, then prefix+suffix ; then prefix.tileNb+suffix |
| 20 |
|
| 21 |
C !USES: |
| 22 |
IMPLICIT NONE |
| 23 |
C === Global variables === |
| 24 |
#include "SIZE.h" |
| 25 |
#include "EEPARAMS.h" |
| 26 |
#include "PARAMS.h" |
| 27 |
|
| 28 |
C !INPUT/OUTPUT PARAMETERS: |
| 29 |
C == Routine arguments == |
| 30 |
C useCurrentDir :: always search for file in the current directory |
| 31 |
C (even if "mdsioLocalDir" is set) |
| 32 |
C filePfx :: file name prefix |
| 33 |
C fileSfx :: file name suffix |
| 34 |
C prtID :: print Identificator (in case file is not found) |
| 35 |
C fileName :: file which has been found |
| 36 |
C fileExist :: True when file has been found |
| 37 |
C myThid :: my Thread Id number |
| 38 |
LOGICAL useCurrentDir |
| 39 |
CHARACTER*(*) filePfx, fileSfx, prtID |
| 40 |
CHARACTER*(*) fileName |
| 41 |
LOGICAL fileExist |
| 42 |
INTEGER myThid |
| 43 |
|
| 44 |
C !FUNCTIONS: |
| 45 |
INTEGER IFNBLNK, ILNBLNK |
| 46 |
EXTERNAL IFNBLNK, ILNBLNK |
| 47 |
|
| 48 |
C !LOCAL VARIABLES: |
| 49 |
C == Local variables in common block == |
| 50 |
LOGICAL shareExist |
| 51 |
COMMON / LOCAL_MDS_CHECK4FILE / shareExist |
| 52 |
C == Local variables == |
| 53 |
CHARACTER*(MAX_LEN_MBUF) msgBuf, msgPfx |
| 54 |
INTEGER iG, jG |
| 55 |
INTEGER lp, ip, is, iL, i, ioUnit |
| 56 |
CEOP |
| 57 |
|
| 58 |
ioUnit = errorMessageUnit |
| 59 |
fileName = ' ' |
| 60 |
|
| 61 |
C-- First check if fileName is long enough |
| 62 |
lp = ILNBLNK( mdsioLocalDir ) |
| 63 |
IF ( useCurrentDir ) lp = 0 |
| 64 |
ip = ILNBLNK(filePfx) |
| 65 |
is = ILNBLNK(fileSfx) |
| 66 |
IF ( ip.EQ.0 ) is = 0 |
| 67 |
i = LEN(fileName) |
| 68 |
IF ( i .LT. lp+ip+is+8 ) THEN |
| 69 |
WRITE(msgBuf,'(A,I6,A,I6)') |
| 70 |
& 'MDS_CHECK4FILE: file name length=', i, |
| 71 |
& ' too small <', lp+ip+is+8 |
| 72 |
CALL PRINT_ERROR( msgBuf, myThid ) |
| 73 |
STOP 'ABNORMAL END: S/R MDS_CHECK4FILE' |
| 74 |
ENDIF |
| 75 |
|
| 76 |
_BARRIER |
| 77 |
_BEGIN_MASTER( myThid ) |
| 78 |
|
| 79 |
C-- Check if file with various suffix exist |
| 80 |
fileExist = .FALSE. |
| 81 |
IF ( .NOT.fileExist .AND. ip.GE.1 ) THEN |
| 82 |
C- look for file = {filePfx} |
| 83 |
WRITE(fileName,'(A)') filePfx(1:ip) |
| 84 |
INQUIRE( FILE=fileName, EXIST=fileExist ) |
| 85 |
ENDIF |
| 86 |
IF ( .NOT.fileExist .AND. is.GE.1 ) THEN |
| 87 |
C- look for file = {filePfx}{fileSfx} |
| 88 |
WRITE(fileName,'(2A)') filePfx(1:ip), fileSfx(1:is) |
| 89 |
INQUIRE( FILE=fileName, EXIST=fileExist ) |
| 90 |
ENDIF |
| 91 |
IF ( .NOT.fileExist .AND. is.GE.1 ) THEN |
| 92 |
C- look for file = {filePfx}'.{iG}.{jG}'{fileSfx} |
| 93 |
iG = 1+(myXGlobalLo-1)/sNx |
| 94 |
jG = 1+(myYGlobalLo-1)/sNy |
| 95 |
IF ( lp.EQ.0 ) THEN |
| 96 |
WRITE(fileName,'(2A,I3.3,A,I3.3,A)') |
| 97 |
& filePfx(1:ip), '.', iG, '.', jG, fileSfx(1:is) |
| 98 |
ELSE |
| 99 |
WRITE(fileName,'(3A,I3.3,A,I3.3,A)') mdsioLocalDir(1:lp), |
| 100 |
& filePfx(1:ip), '.', iG, '.', jG, fileSfx(1:is) |
| 101 |
ENDIF |
| 102 |
INQUIRE( FILE=fileName, EXIST=fileExist ) |
| 103 |
ENDIF |
| 104 |
IF ( .NOT.fileExist .AND. is.GE.1 ) THEN |
| 105 |
C- look for file = {filePfx}'.001.001'{fileSfx} |
| 106 |
IF ( lp.EQ.0 ) THEN |
| 107 |
WRITE(fileName,'(3A)') |
| 108 |
& filePfx(1:ip), '.001.001', fileSfx(1:is) |
| 109 |
ELSE |
| 110 |
WRITE(fileName,'(4A)') mdsioLocalDir(1:lp), |
| 111 |
& filePfx(1:ip), '.001.001', fileSfx(1:is) |
| 112 |
ENDIF |
| 113 |
INQUIRE( FILE=fileName, EXIST=fileExist ) |
| 114 |
ENDIF |
| 115 |
|
| 116 |
IF ( .NOT.fileExist ) THEN |
| 117 |
ip = MAX(ILNBLNK(filePfx),1) |
| 118 |
is = MAX(is,1) |
| 119 |
i = MAX(ILNBLNK(fileName),1) |
| 120 |
iL = ILNBLNK(prtID) |
| 121 |
IF ( iL.GE.1 ) THEN |
| 122 |
WRITE(msgPfx,'(2A)') 'WARNING >> ',prtID(1:iL) |
| 123 |
ELSE |
| 124 |
WRITE(msgPfx,'(2A)') 'WARNING >> MDS_CHECK4FILE' |
| 125 |
ENDIF |
| 126 |
iL = ILNBLNK(msgPfx) |
| 127 |
WRITE(msgBuf,'(7A)') msgPfx(1:iL), ': file: ', |
| 128 |
& filePfx(1:ip), ' , ', fileSfx(1:is), ' , ', fileName(1:i) |
| 129 |
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) |
| 130 |
WRITE(msgBuf,'(2A)') msgPfx(1:iL), ': Files DO not exist' |
| 131 |
CALL PRINT_MESSAGE( msgBuf, ioUnit, SQUEEZE_RIGHT, myThid ) |
| 132 |
fileName = ' ' |
| 133 |
ENDIF |
| 134 |
|
| 135 |
shareExist = fileExist |
| 136 |
|
| 137 |
_END_MASTER( myThid ) |
| 138 |
_BARRIER |
| 139 |
|
| 140 |
fileExist = shareExist |
| 141 |
|
| 142 |
RETURN |
| 143 |
END |
Parent Directory
| 
Revision Log
| 
Revision Graph