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 |