File: RELATIVE:/../../../mfix.git/model/open_files.f

1     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2     !                                                                      !
3     !  Module name: OPEN_FILES                                             !
4     !  Author: P. Nicoletti                               Date: 12-DEC-91  !
5     !                                                                      !
6     !  Purpose: open all the files for this run                            !
7     !                                                                      !
8     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
9           SUBROUTINE OPEN_FILES(RUN_NAME, RUN_TYPE, N_SPX)
10     
11           USE machine
12           USE funits
13           USE compar
14           USE cdist
15     
16           use error_manager
17     
18           IMPLICIT NONE
19     
20     ! Error index: 0 - no error, 1 could not open file
21           INTEGER :: IER(0:numPEs-1)
22     ! RUN_NAME (as specified in input file)
23           CHARACTER(LEN=*) :: RUN_NAME
24     ! Run_type (as specified in input file)
25           CHARACTER(LEN=*) :: RUN_TYPE
26     ! Number of single precision output files (param.inc)
27           INTEGER :: N_SPX
28     ! local variables
29           CHARACTER(len=4) :: EXT
30     ! run_name + extension
31           CHARACTER(len=255) :: FILE_NAME
32     ! Loop counter
33           INTEGER :: LC
34     ! index to first blank character in run_name
35           INTEGER :: NB
36           CHARACTER(len=35) :: EXT_END
37           CHARACTER(len=10) :: CSTATUS
38     ! Character error code.
39           CHARACTER(len=32) :: CER
40     !-----------------------------------------------
41     
42     
43     ! Initialize the error manager.
44           CALL INIT_ERR_MSG("OPEN_FILES")
45     
46     ! Initialize the error flag array.
47           IER = 0
48     
49     ! Initialize the generic SPx extension.
50           EXT = '.SPx'
51     
52     ! Generic SPx end characters in order.
53           EXT_END = '123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
54     
55     ! Get the length of RUN_NAME. Note that len_trim would allow the
56     ! name to still contain spaces. The following approach truncates
57     ! RUN_NAME at the first blank character.
58           NB = INDEX(RUN_NAME,' ')
59     
60     ! Only PE_IO opens the RUN_NAME.OUT file.
61           IF(myPE == PE_IO) CALL OPEN_FILE (RUN_NAME, NB, UNIT_OUT, '.OUT',&
62              FILE_NAME, 'UNKNOWN', 'SEQUENTIAL','FORMATTED',132, IER(myPE))
63     
64     ! Check if there was an error opening the file.
65           IF(ERROR_OPENING(IER)) THEN
66              WRITE(ERR_MSG,3000)
67              CALL FLUSH_ERR_MSG(ABORT=.TRUE.)
68           ENDIF
69     
70     
71     ! Open the RES and SPx files. By default, only PE_IO opens these files,
72     ! but all ranks open a rank-specific copy for distributed IO runs.
73           SELECT CASE (TRIM(RUN_TYPE))
74     
75     ! Open the RES and SPx files for a new run.
76     !......................................................................
77           CASE ('NEW')
78     
79              IF(myPE==PE_IO .OR.  bDist_IO) THEN
80     
81     ! Open the RES file.
82                 CALL OPEN_FILE (RUN_NAME, NB, UNIT_RES, '.RES', FILE_NAME, &
83                    'NEW', 'DIRECT', 'UNFORMATTED', OPEN_N1, IER(myPE))
84     ! Report errors.
85                 IF (IER(myPE) == 100) THEN
86                    WRITE(ERR_MSG, 1000)'RES', 'NEW', trim(FILE_NAME)
87                    CALL FLUSH_ERR_MSG
88                    GO TO 100
89                 ELSEIF(IER(myPE) /= 0) THEN
90                    CER=''; WRITE(CER,*)
91                    WRITE(ERR_MSG, 2000) trim(FILE_NAME), trim(CER)
92                    CALL FLUSH_ERR_MSG
93                    GO TO 100
94                 ENDIF
95     
96     ! Open the SPx files.
97                 DO LC = 1, N_SPX
98                    EXT(4:4) = ext_end(LC:LC)
99                    CALL OPEN_FILE(RUN_NAME, NB, UNIT_SPX+LC, EXT,FILE_NAME,&
100                       'NEW', 'DIRECT', 'UNFORMATTED', OPEN_N1, IER(myPE))
101     ! Report errors.
102                    IF (IER(myPE) == 100) THEN
103                       WRITE(ERR_MSG, 1000)EXT(2:4), 'NEW', trim(FILE_NAME)
104                       CALL FLUSH_ERR_MSG
105                       GO TO 100
106                    ELSEIF(IER(myPE) /= 0) THEN
107                       CER=''; WRITE(CER,*)
108                       WRITE(ERR_MSG, 2000) trim(FILE_NAME), trim(CER)
109                       CALL FLUSH_ERR_MSG
110                       GO TO 100
111                    ENDIF
112                 ENDDO
113              ENDIF
114     
115     
116     ! Open the RES and SPx files for a typical restart run.
117     !......................................................................
118           CASE ('RESTART_1')
119     
120     ! Open the RES file.
121              IF(myPE == PE_IO .or. bDist_IO) THEN
122                 CALL OPEN_FILE(RUN_NAME, NB, UNIT_RES, '.RES', FILE_NAME,  &
123                    'OLD', 'DIRECT', 'UNFORMATTED', OPEN_N1, IER(myPE))
124     ! Report errors.
125                 IF (IER(myPE) == 101) THEN
126                    WRITE(ERR_MSG, 1001)'RES', 'RESTART_1',trim(FILE_NAME)
127                    CALL FLUSH_ERR_MSG
128                    GO TO 100
129                 ELSEIF(IER(myPE) /= 0) THEN
130                    CER=''; WRITE(CER,*)
131                    WRITE(ERR_MSG, 2000) trim(FILE_NAME), trim(CER)
132                    CALL FLUSH_ERR_MSG
133                    GO TO 100
134                 ENDIF
135     
136     ! Open the SPx files.
137                 DO LC = 1, N_SPX
138                    EXT(4:4) = EXT_END(LC:LC)
139                    CALL OPEN_FILE (RUN_NAME,NB, UNIT_SPX+LC,EXT, FILE_NAME,&
140                       'OLD', 'DIRECT', 'UNFORMATTED', OPEN_N1, IER(myPE))
141     ! Report errors.
142                    IF (IER(myPE) == 101) THEN
143                       WRITE(ERR_MSG, 1001) EXT(2:4), 'RESTART_1',         &
144                          trim(FILE_NAME)
145                       CALL FLUSH_ERR_MSG
146                       GO TO 100
147                    ELSEIF(IER(myPE) /= 0) THEN
148                       CER=''; WRITE(CER,*)
149                       WRITE(ERR_MSG, 2000) trim(FILE_NAME), trim(CER)
150                       CALL FLUSH_ERR_MSG
151                       GO TO 100
152                    ENDIF
153                 END DO
154              ENDIF
155     
156     
157     ! Open the RES and SPx files for a typical restart run.
158     !......................................................................
159           CASE ('RESTART_2')
160     ! Open the RES file.
161              CSTATUS = 'OLD'
162              IF(myPE == PE_IO .OR. bDist_IO) THEN
163                 IF(bStart_with_one_res) CSTATUS = 'UNKNOWN'
164                 CALL OPEN_FILE (RUN_NAME, NB, UNIT_RES, '.RES', FILE_NAME, &
165                    CSTATUS,'DIRECT', 'UNFORMATTED', OPEN_N1, IER(myPE))
166     ! Report errors.
167                 IF (IER(myPE) == 101) THEN
168                    WRITE(ERR_MSG, 1001)'RES', 'RESTART_2',trim(FILE_NAME)
169                    CALL FLUSH_ERR_MSG
170                    GO TO 100
171                 ELSEIF(IER(myPE) /= 0) THEN
172                    CER=''; WRITE(CER,*)
173                    WRITE(ERR_MSG, 2000) trim(FILE_NAME), trim(CER)
174                    CALL FLUSH_ERR_MSG
175                    GO TO 100
176                 ENDIF
177     
178     ! Open the SPx files.
179                 DO LC = 1, N_SPX
180                    EXT(4:4) = EXT_END(LC:LC)
181                    CALL OPEN_FILE (RUN_NAME,NB,UNIT_SPX+LC, EXT, FILE_NAME,&
182                       'NEW' , 'DIRECT', 'UNFORMATTED', OPEN_N1, IER(myPE))
183     ! Report errors.
184                    IF (IER(myPE) == 100) THEN
185                       WRITE(ERR_MSG, 1000)EXT(2:4), 'RESTART_2',          &
186                          trim(FILE_NAME)
187                       CALL FLUSH_ERR_MSG
188                       GO TO 100
189                    ELSEIF(IER(myPE) /= 0) THEN
190                       CER=''; WRITE(CER,*)
191                       WRITE(ERR_MSG, 2000) trim(FILE_NAME), trim(CER)
192                       CALL FLUSH_ERR_MSG
193                       GO TO 100
194                    ENDIF
195                 END DO
196              ENDIF
197     
198           CASE DEFAULT
199              WRITE(ERR_MSG, 3000)
200              CALL FLUSH_ERR_MSG
201              GO TO 100
202     
203           END SELECT
204     
205     ! If an error was detected, abort the run.
206       100 IF(ERROR_OPENING(IER)) CALL MFIX_EXIT(myPE)
207     
208     ! Initialize the error manager.
209           CALL FINL_ERR_MSG
210     
211           RETURN
212     
213      1000 FORMAT('Error 1000: ',A,' file detected but RUN_TYPE=',A/,       &
214              'Cannot open file: ',A)
215     
216      1001 FORMAT('Error 1001: ',A,' file missing for RUN_TYPE=',A/,        &
217              'Cannot open file: ',A)
218     
219      2000 FORMAT('Error 2000: Unknown error opening file ',A,/             &
220              'Error code: ',A)
221     
222      3000 FORMAT('Error 3000: Unknown run type: ',A)
223     
224     
225           CONTAINS
226     
227     
228     !``````````````````````````````````````````````````````````````````````!
229     ! FUNCTION: ERROR_OPENING                                              !
230     ! Purpose: Collect the error flags from all processes and sum them.    !
231     ! RESULT: .TRUE.  :: Sum of IER over all processes is non-zero.        !
232     !         .FALSE. :: GLOBAL_ALL_SUM is zero.                           !
233     !                                                                      !
234     !......................................................................!
235           LOGICAL FUNCTION ERROR_OPENING(IER_l)
236     
237     ! MPI Wrapper function.
238           use mpi_utility, only: GLOBAL_ALL_SUM
239     
240     ! Array containing error flags from all ranks.
241           INTEGER, INTENT(IN) :: IER_L(0:numPEs-1)
242     ! Initialize error flags.
243           ERROR_OPENING = .FALSE.
244     ! Globally collect flags.
245           CALL GLOBAL_ALL_SUM(IER)
246     ! Report errors.
247           IF(sum(IER_l) /= 0) ERROR_OPENING = .TRUE.
248     
249           RETURN
250           END FUNCTION ERROR_OPENING
251     
252           END SUBROUTINE OPEN_FILES
253     
254     
255     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
256     !                                                                      !
257     !  Module name: OPEN_PE_LOG                                            !
258     !  Author: P. Nicoletti                               Date: 12-DEC-91  !
259     !                                                                      !
260     !  Purpose: Every rank open a .LOG file for domain specific errors.    !
261     !  This routine should only be invoked before writing to the log and   !
262     !  exiting.                                                            !
263     !                                                                      !
264     !  This routine only opens files when the following are met:           !
265     !    (1) MFIX is run in DMP parallel (MPI)                             !
266     !    (2) ENABLE_DMP_LOG is not set in the mfix.dat file.               !
267     !                                                                      !
268     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
269           SUBROUTINE OPEN_PE_LOG(IER)
270     
271     ! Global Variables:
272     !---------------------------------------------------------------------//
273     ! File unit for LOG files.
274           USE funits, only: UNIT_LOG
275     ! User specifed run name
276           USE run, only: RUN_NAME
277     ! MPI Rank of current process.
278           USE compar, only: myPE
279     ! Total number of MPI ranks.
280           USE compar, only: numPEs
281     ! Flag: My rank reports errors.
282           use funits, only: DMP_LOG
283     ! Flag: The log had to be opened.
284           use funits, only: LOG_WAS_CLOSED
285     
286           IMPLICIT NONE
287     
288     ! Dummy Arguments:
289     !---------------------------------------------------------------------//
290     ! Error index.
291           INTEGER, INTENT(inout) :: IER
292     
293     ! Local Variables:
294     !---------------------------------------------------------------------//
295     ! Log file name.
296           CHARACTER(len=255) :: LOGFILE
297           CHARACTER(len=255) :: FILE_NAME
298     ! Flag for LOG files that are already open.
299           LOGICAL :: DO_NOTHING
300     ! Index of first blank character in RUN_NAME
301           INTEGER :: NB
302     !......................................................................!
303     
304     
305     ! Enable output from this rank.
306           DMP_LOG = .TRUE.
307     
308     ! Return to the caller if this rank is already connect to a log file.
309           INQUIRE(UNIT=UNIT_LOG, OPENED=DO_NOTHING)
310           IF(DO_NOTHING) RETURN
311     
312     ! Flag that the log had to be opened.
313           LOG_WAS_CLOSED = .TRUE.
314     
315     ! Verify the length of user-provided name.
316           LOGFILE = ''
317           NB = INDEX(RUN_NAME,' ')
318     
319     ! Specify the .LOG file name based on MPI Rank extenion.
320           IF(numPEs == 1) THEN
321              WRITE(LOGFILE,"(A)")RUN_NAME(1:(NB-1))
322           ELSEIF(numPEs <    10) THEN
323              WRITE(LOGFILE,"(A,'_',I1.1)") RUN_NAME(1:(NB-1)), myPE
324           ELSEIF(numPEs <   100) THEN
325              WRITE(LOGFILE,"(A,'_',I2.2)") RUN_NAME(1:(NB-1)), myPE
326           ELSEIF(numPEs <  1000) THEN
327              WRITE(LOGFILE,"(A,'_',I3.3)") RUN_NAME(1:(NB-1)), myPE
328           ELSEIF(numPEs < 10000) THEN
329              WRITE(LOGFILE,"(A,'_',I4.4)") RUN_NAME(1:(NB-1)), myPE
330           ELSE
331              WRITE(LOGFILE,"(A,'_',I8.8)") RUN_NAME(1:(NB-1)), myPE
332           ENDIF
333     
334     ! Open the .LOG file. From here forward, all routines should store
335     ! error messages (at a minimum) in the .LOG file.
336           NB = len_trim(LOGFILE)+1
337           CALL OPEN_FILE(LOGFILE, NB, UNIT_LOG, '.LOG', FILE_NAME,         &
338              'APPEND', 'SEQUENTIAL', 'FORMATTED', 132,  IER)
339     
340           RETURN
341           END SUBROUTINE OPEN_PE_LOG
342     
343     
344     !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
345     !                                                                      !
346     !  Module name: CLOSE_PE_LOG                                           !
347     !  Author: P. Nicoletti                               Date: 12-DEC-91  !
348     !                                                                      !
349     !  Purpose: Every rank open a .LOG file for domain specific errors.    !
350     !  This routine should only be invoked before writing to the log and   !
351     !  exiting.                                                            !
352     !                                                                      !
353     !  This routine only opens files when the following are met:           !
354     !    (1) MFIX is run in DMP parallel (MPI)                             !
355     !    (2) ENABLE_DMP_LOG is not set in the mfix.dat file.               !
356     !                                                                      !
357     !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
358           SUBROUTINE CLOSE_PE_LOG
359     
360     ! Global Variables:
361     !---------------------------------------------------------------------//
362     ! File unit for LOG files.
363           USE funits, only: UNIT_LOG
364     ! Flag: My rank reports errors.
365           use funits, only: DMP_LOG
366     ! Flag: The log had to be opened.
367           use funits, only: LOG_WAS_CLOSED
368     
369           IMPLICIT NONE
370     
371     !......................................................................!
372     
373     
374     ! The log had to be opened for global error.
375           IF(LOG_WAS_CLOSED) THEN
376     ! Reset the flag.
377              LOG_WAS_CLOSED = .FALSE.
378     ! Disable output from this rank and close connection to LOG.
379              DMP_LOG = .FALSE.
380     ! Return to the caller if this rank is already connect to a log file.
381              CLOSE(UNIT_LOG)
382           ENDIF
383     
384           RETURN
385           END SUBROUTINE CLOSE_PE_LOG
386