File: N:\mfix\model\output_manager.f

1     MODULE output_man
2        CONTAINS
3     !----------------------------------------------------------------------!
4     !                                                                      !
5     !  Subroutine: OUTPUT_MANAGER                                          !
6     !  Author: J.Musser                                   Date:            !
7     !                                                                      !
8     !  Purpose: Relocate calls to write output files (RES, SPx, VTP). This !
9     !  was done to simplify the time_march code.                           !
10     !                                                                      !
11     !----------------------------------------------------------------------!
12           SUBROUTINE OUTPUT_MANAGER(EXIT_SIGNAL, FINISHED)
13     
14     ! Global Variables:
15     !---------------------------------------------------------------------//
16     
17           use compar, only: myPE, PE_IO
18           use discretelement, only: DISCRETE_ELEMENT
19           use machine, only: wall_time
20           use output, only: DISK, DISK_TOT
21           use output, only: OUT_TIME, OUT_DT
22           use output, only: RES_BACKUP_TIME, RES_BACKUP_DT
23           use output, only: RES_TIME, RES_DT
24           use output, only: SPX_TIME, SPX_DT
25           use output, only: USR_TIME, USR_DT
26           use param, only: DIMENSION_USR
27           use param1, only: N_SPX
28           use qmom_kinetic_equation, only: QMOMK
29           use run, only: TIME, DT, TSTOP, STEADY_STATE
30           use time_cpu, only: CPU_IO
31           use vtk, only:    VTK_TIME, VTK_DT
32           use vtk, only: DIMENSION_VTK
33           use vtk, only: WRITE_VTK_FILES
34           use vtp, only: write_vtp_file
35     
36           IMPLICIT NONE
37     
38     ! Dummy Arguments:
39     !---------------------------------------------------------------------//
40     ! Flag that the the user specified batch time (plus buffer) is met.
41           LOGICAL, INTENT(IN) :: EXIT_SIGNAL
42     ! Flag that a steady state case is completed.
43           LOGICAL, INTENT(IN) :: FINISHED
44     
45     ! Local Variables:
46     !---------------------------------------------------------------------//
47     ! Loop counter and counter
48           INTEGER :: LC, IDX
49     ! Flag to write NetCDF output
50           LOGICAL :: bWRITE_NETCDF_FILES
51     ! Flag that the header (time) has not be written.
52           LOGICAL :: HDR_MSG
53     ! SPX file extensions.
54           CHARACTER(LEN=35) ::  EXT_END
55     ! Wall time at the start of IO operations.
56           DOUBLE PRECISION :: WALL_START
57     
58     !......................................................................!
59     
60     ! Initialize the SPx file extension array.
61           EXT_END = '123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
62     ! Initial the header flag.
63           HDR_MSG = .TRUE.
64     
65     ! Get the current time before any IO operations begin
66           WALL_START = WALL_TIME()
67     
68     ! Create a backup copy of the RES file.
69           IF(TIME+0.1d0*DT>=RES_BACKUP_TIME) THEN
70              RES_BACKUP_TIME = NEXT_TIME(RES_BACKUP_DT)
71              CALL BACKUP_RES
72           ENDIF
73     
74     ! Write restart file, if needed
75           IF(CHECK_TIME(RES_TIME) .OR. EXIT_SIGNAL) THEN
76     
77              RES_TIME = NEXT_TIME(RES_DT)
78              CALL WRITE_RES1
79              CALL NOTIFY_USER('.RES;')
80     
81              IF(DISCRETE_ELEMENT) THEN
82                 CALL WRITE_RES0_DES
83                 CALL NOTIFY_USER('DES.RES;')
84              ENDIF
85     
86              IF(QMOMK) THEN
87                 CALL QMOMK_WRITE_RESTART
88                 CALL NOTIFY_USER('QMOMK.RES;')
89              ENDIF
90     
91           ENDIF
92     
93     ! Write SPx files, if needed
94           IDX = 0
95           bWRITE_NETCDF_FILES = .FALSE.
96     
97           DO LC=1, N_SPX
98              IF(CHECK_TIME(SPX_TIME(LC))) THEN
99                 SPX_TIME(LC) = NEXT_TIME(SPX_DT(LC))
100     
101                 CALL WRITE_SPX1(LC, 0)
102                 CALL NOTIFY_USER('SPx:',EXT_END(LC:LC))
103     
104                 DISK_TOT = DISK_TOT + DISK(LC)
105                 IDX = IDX + 1
106     
107                 bWRITE_NETCDF_FILES = .TRUE.
108              ENDIF
109           ENDDO
110           IF(IDX /=0) CALL FLUSH_LIST
111     
112     
113     ! Write standard output, if needed
114           IF(CHECK_TIME(OUT_TIME)) THEN
115              OUT_TIME = NEXT_TIME(OUT_DT)
116              CALL WRITE_OUT1
117              CALL NOTIFY_USER('.OUT;')
118           ENDIF
119     
120     ! Write special output, if needed
121           IDX = 0
122           DO LC = 1, DIMENSION_USR
123              IF(CHECK_TIME(USR_TIME(LC))) THEN
124                 USR_TIME(LC) = NEXT_TIME(USR_DT(LC))
125                 CALL WRITE_USR1 (LC)
126                 CALL NOTIFY_USER('.USR:',EXT_END(LC:LC))
127                 IDX = IDX + 1
128              ENDIF
129           ENDDO
130           IF(IDX /=0) CALL FLUSH_LIST
131     
132           CALL FLUSH_NOTIFY_USER
133     
134     ! Write vtk file, if needed
135     ! Only regular (not debug) files are written (second argument is zero)
136           IF(WRITE_VTK_FILES) THEN
137              DO LC = 1, DIMENSION_VTK
138                 IF(CHECK_TIME(VTK_TIME(LC))) THEN
139                    VTK_TIME(LC) = NEXT_TIME(VTK_DT(LC))
140                    CALL WRITE_VTU_FILE(LC,0)
141                    IF(DISCRETE_ELEMENT) CALL WRITE_VTP_FILE(LC,0)
142                 ENDIF
143              ENDDO
144           ENDIF
145     
146     ! Write NetCDF files.
147           IF(bWRITE_NETCDF_FILES) CALL WRITE_NETCDF(0,0,TIME)
148     
149     ! Add the amount of time needed for all IO operations to total.
150           CPU_IO = CPU_IO + (WALL_TIME() - WALL_START)
151     
152           RETURN
153     
154           contains
155     
156     !----------------------------------------------------------------------!
157     !                                                                      !
158     !----------------------------------------------------------------------!
159           LOGICAL FUNCTION CHECK_TIME(lTIME)
160     
161           DOUBLE PRECISION, INTENT(IN) :: lTIME
162     
163           IF(STEADY_STATE) THEN
164              CHECK_TIME = FINISHED
165           ELSE
166              CHECK_TIME = (TIME+0.1d0*DT>=lTIME).OR.(TIME+0.1d0*DT>=TSTOP)
167           ENDIF
168     
169           RETURN
170           END FUNCTION CHECK_TIME
171     
172     !----------------------------------------------------------------------!
173     !                                                                      !
174     !----------------------------------------------------------------------!
175           DOUBLE PRECISION FUNCTION NEXT_TIME(lWRITE_DT)
176     
177           DOUBLE PRECISION, INTENT(IN) :: lWRITE_DT
178     
179           IF (.NOT.STEADY_STATE) THEN
180              NEXT_TIME = (INT((TIME + 0.1d0*DT)/lWRITE_DT)+1)*lWRITE_DT
181           ELSE
182              NEXT_TIME = lWRITE_DT
183           ENDIF
184     
185           RETURN
186           END FUNCTION NEXT_TIME
187     
188     !----------------------------------------------------------------------!
189     !                                                                      !
190     !----------------------------------------------------------------------!
191           SUBROUTINE NOTIFY_USER(MSG, EXT)
192     
193           use output, only: FULL_LOG
194           use funits, only: DMP_LOG
195           use funits, only: UNIT_LOG
196     
197           CHARACTER(len=*), INTENT(IN) :: MSG
198           CHARACTER(len=*), INTENT(IN), OPTIONAL :: EXT
199     
200     
201           LOGICAL :: SCR_LOG
202     
203           SCR_LOG = (FULL_LOG .and. myPE.eq.PE_IO)
204     
205           IF(HDR_MSG) THEN
206              IF(DMP_LOG) WRITE(UNIT_LOG, 1000, ADVANCE='NO') TIME
207              IF(SCR_LOG) WRITE(*, 1000, ADVANCE='NO') TIME
208              HDR_MSG = .FALSE.
209           ENDIF
210     
211      1000 FORMAT(' ',/' t=',F12.6,' Wrote')
212     
213           IF(.NOT.present(EXT)) THEN
214              IF(DMP_LOG) WRITE(UNIT_LOG, 1100, ADVANCE='NO') MSG
215              IF(SCR_LOG) WRITE(*, 1100, ADVANCE='NO') MSG
216           ELSE
217              IF(IDX == 0) THEN
218                 IF(DMP_LOG) WRITE(UNIT_LOG, 1110, ADVANCE='NO') MSG, EXT
219                 IF(SCR_LOG) WRITE(*, 1110, ADVANCE='NO') MSG, EXT
220              ELSE
221                 IF(DMP_LOG) WRITE(UNIT_LOG, 1120, ADVANCE='NO') EXT
222                 IF(SCR_LOG) WRITE(*, 1120, ADVANCE='NO') EXT
223              ENDIF
224           ENDIF
225     
226      1100 FORMAT(1X,A)
227      1110 FORMAT(1X,A,1x,A)
228      1120 FORMAT(',',A)
229     
230           RETURN
231           END SUBROUTINE NOTIFY_USER
232     
233     !----------------------------------------------------------------------!
234     !                                                                      !
235     !----------------------------------------------------------------------!
236           SUBROUTINE FLUSH_LIST
237     
238           use output, only: FULL_LOG
239           use funits, only: DMP_LOG
240           use funits, only: UNIT_LOG
241     
242           LOGICAL :: SCR_LOG
243     
244           SCR_LOG = (FULL_LOG .and. myPE.eq.PE_IO)
245     
246           IF(DMP_LOG) WRITE(UNIT_LOG,1000, ADVANCE='NO')
247           IF(SCR_LOG) WRITE(*,1000, ADVANCE='NO')
248     
249      1000 FORMAT(';')
250     
251           RETURN
252           END SUBROUTINE FLUSH_LIST
253     
254     
255     !----------------------------------------------------------------------!
256     !                                                                      !
257     !----------------------------------------------------------------------!
258           SUBROUTINE FLUSH_NOTIFY_USER
259     
260           use discretelement, only: DISCRETE_ELEMENT, DES_CONTINUUM_COUPLED
261           use discretelement, only: DTSOLID
262           use error_manager
263           use funits, only: DMP_LOG
264           use funits, only: UNIT_LOG
265           use machine, only: wall_time
266           use run, only: get_tunit
267           use output, only: FULL_LOG
268           use output, only: NLOG
269           use run, only: TIME, NSTEP, STEADY_STATE
270           use time_cpu, only: TIME_START
271           use time_cpu, only: WALL_START
272     
273           DOUBLE PRECISION :: WALL_ELAP, WALL_LEFT, WALL_NOW
274           CHARACTER(LEN=9) :: CHAR_ELAP, CHAR_LEFT
275           CHARACTER(LEN=4) :: UNIT_ELAP, UNIT_LEFT
276     
277           INTEGER :: TNITS
278           LOGICAL :: SCR_LOG
279     
280           SCR_LOG = (FULL_LOG .and. myPE.eq.PE_IO)
281     
282           IF(.NOT.HDR_MSG) THEN
283              IF(DMP_LOG) WRITE(UNIT_LOG,1000)
284              IF(SCR_LOG) WRITE(*,1000)
285           ENDIF
286     
287      1000 FORMAT(' ',/' ')
288     
289     ! Write the elapsed time and estimated remaining time
290           IF(MOD(NSTEP,NLOG) == 0) THEN
291     
292              IF(DISCRETE_ELEMENT .AND. .NOT.DES_CONTINUUM_COUPLED) THEN
293                 TNITs = CEILING(real((TSTOP-TIME)/DTSOLID))
294                 WRITE(ERR_MSG, 1100) TIME, DTSOLID, trim(iVal(TNITs))
295                 CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE., LOG=.FALSE.)
296              ENDIF
297      1100 FORMAT(/'Time: ',g12.5,3x,'DT: ',g12.5,3x,'Remaining DEM NITs: ',A)
298     
299              WALL_NOW = WALL_TIME()
300     ! Calculate the elapsed wall time.
301              WALL_ELAP = WALL_NOW - WALL_START
302              CALL GET_TUNIT(WALL_ELAP, UNIT_ELAP)
303              CHAR_ELAP=''; WRITE(CHAR_ELAP,"(F9.2)") WALL_ELAP
304              CHAR_ELAP = trim(adjustl(CHAR_ELAP))
305     ! Estimate the remaining wall time.
306              WALL_LEFT = (WALL_NOW-WALL_START)*(TSTOP-TIME)/               &
307                 max(TIME-TIME_START,1.0d-6)
308              CALL GET_TUNIT(WALL_LEFT, UNIT_LEFT)
309     
310              IF (.NOT.STEADY_STATE) THEN
311                 CHAR_LEFT=''; WRITE(CHAR_LEFT,"(F9.2)") WALL_LEFT
312                 CHAR_LEFT = trim(adjustl(CHAR_LEFT))
313              ELSE
314                 CHAR_LEFT = '0.0'
315                 UNIT_LEFT = 's'
316              ENDIF
317     
318     ! Notify the user of usage/remaining wall times.
319              WRITE(ERR_MSG,2000)                                           &
320                 'Elapsed:', trim(CHAR_ELAP), trim(UNIT_ELAP),              &
321                 'Est. Remaining:',trim(CHAR_LEFT), trim(UNIT_LEFT)
322              CALL FLUSH_ERR_MSG(HEADER=.FALSE., FOOTER=.FALSE.)
323           ENDIF
324     
325      2000 FORMAT('Wall Time - ',2(A,1X,A,A,4X))
326     
327           RETURN
328           END SUBROUTINE FLUSH_NOTIFY_USER
329     
330           END SUBROUTINE OUTPUT_MANAGER
331     
332     !----------------------------------------------------------------------!
333     ! Subroutine: INIT_OUTPUT_VARS                                         !
334     ! Purpose: Initialize variables used for controling ouputs of the      !
335     ! various files.                                                       !
336     !----------------------------------------------------------------------!
337           SUBROUTINE INIT_OUTPUT_VARS
338     
339           use geometry, only: IJKMAX2
340           use machine, only: wall_time
341           use output, only: DISK, DISK_TOT
342           use output, only: ONEMEG
343           use output, only: OUT_TIME, OUT_DT
344           use output, only: RES_TIME, RES_DT
345           use output, only: SPX_TIME, SPX_DT
346           use output, only: USR_TIME, USR_DT
347           use output, only: RES_BACKUP_TIME, RES_BACKUP_DT
348           use output, only: RES_BACKUPS
349           use param, only: DIMENSION_USR
350           use param1, only: N_SPX
351           use param1, only: UNDEFINED
352           use param1, only: ZERO
353           use physprop, only: MMAX, NMAX
354           use run, only: K_EPSILON
355           use run, only: RUN_TYPE
356           use run, only: TIME, DT, STEADY_STATE
357           use rxns, only: nRR
358           use scalars, only: NScalar
359           use time_cpu, only: CPU_IO
360           use time_cpu, only: TIME_START
361           use time_cpu, only: WALL_START
362           use vtk, only:    VTK_TIME, VTK_DT
363           use vtk, only: DIMENSION_VTK
364           use vtk, only: DIMENSION_VTK
365           use vtk, only: VTK_TIME, VTK_DT
366           use vtk, only: WRITE_VTK_FILES
367     
368           use param1, only:  UNDEFINED_I
369     
370           use funits, only: CREATE_DIR
371     
372           IMPLICIT NONE
373     
374     ! Disk space needed for one variable and each SPX file
375           DOUBLE PRECISION :: DISK_ONE
376     
377     ! Loop counter
378           INTEGER :: LC
379     
380     ! Initialize times for writing outputs
381           OUT_TIME = merge(TIME, UNDEFINED, OUT_DT /= UNDEFINED)
382     
383     ! Initialize the amount of time spent on IO
384           CPU_IO = 0.0d0
385     
386     ! Initialize disk space calculations
387           DISK_TOT = ZERO
388           DISK_ONE = 4.0*IJKMAX2/ONEMEG
389     
390           DISK(1) = 1.0*DISK_ONE                           ! EPg
391           DISK(2) = 2.0*DISK_ONE                           ! Pg, Ps
392           DISK(3) = 3.0*DISK_ONE                           ! Ug, Vg, Wg
393           DISK(4) = 3.0*DISK_ONE*MMAX                      ! Us, Vs, Ws
394           DISK(5) = 1.0*DISK_ONE*MMAX                      ! ROPs
395           DISK(6) = 1.0*DISK_ONE*(MMAX+1)                  ! Tg, Ts
396           DISK(7) = 1.0*DISK_ONE*(sum(NMAX(0:MMAX)))       ! Xg, Xs
397           DISK(8) = 1.0*DISK_ONE*MMAX                      ! Theta
398           DISK(9) = 1.0*DISK_ONE*NScalar                   ! User Scalars
399           DISK(10) = nRR*DISK_ONE                          ! ReactionRates
400           DISK(11) = merge(2.0*DISK_ONE, ZERO, K_EPSILON)  ! K-Epsilon
401     
402     
403     ! Initizle RES and SPX_TIME
404           IF (RUN_TYPE == 'NEW') THEN
405              RES_TIME = TIME
406              SPX_TIME(:N_SPX) = TIME
407           ELSE
408              IF (.NOT. STEADY_STATE) THEN
409                 RES_TIME = RES_DT *                                        &
410                    (INT((TIME + 0.1d0*DT)/RES_DT) + 1)
411                 SPX_TIME(:N_SPX) = SPX_DT(:N_SPX) *                        &
412                    (INT((TIME + 0.1d0*DT)/SPX_DT(:N_SPX)) + 1)
413              ENDIF
414           ENDIF
415     
416     ! Initizle RES_BACKUP_TIME
417           RES_BACKUP_TIME = UNDEFINED
418           IF(RES_BACKUP_DT /= UNDEFINED) RES_BACKUP_TIME =                 &
419              RES_BACKUP_DT * (INT((TIME+0.1d0*DT)/RES_BACKUP_DT)+1)
420     
421     ! Initialize USR_TIME
422           DO LC = 1, DIMENSION_USR
423              USR_TIME(LC) = UNDEFINED
424              IF (USR_DT(LC) /= UNDEFINED) THEN
425                 IF (RUN_TYPE == 'NEW') THEN
426                    USR_TIME(LC) = TIME
427                 ELSE
428                    USR_TIME(LC) = USR_DT(LC) *                             &
429                       (INT((TIME+0.1d0*DT)/USR_DT(LC))+1)
430                 ENDIF
431              ENDIF
432           ENDDO
433     
434     ! Initialize VTK_TIME
435     
436           IF(WRITE_VTK_FILES) THEN
437              DO LC = 1, DIMENSION_VTK
438                 VTK_TIME(LC) = UNDEFINED
439                 IF (VTK_DT(LC) /= UNDEFINED) THEN
440                    IF (RUN_TYPE == 'NEW'.OR.RUN_TYPE=='RESTART_2') THEN
441                       VTK_TIME(LC) = TIME
442                    ELSE
443                       VTK_TIME(LC) = VTK_DT(LC) *                          &
444                          (INT((TIME + 0.1d0*DT)/VTK_DT(LC))+1)
445                    ENDIF
446                 ENDIF
447              ENDDO
448           ENDIF
449     
450     ! Create a subdir for RES backup files.
451           IF(RES_BACKUPS /= UNDEFINED_I) CALL CREATE_DIR('BACKUP_RES')
452     
453           WALL_START = WALL_TIME()
454           TIME_START = TIME
455     
456           RETURN
457           END SUBROUTINE INIT_OUTPUT_VARS
458     
459     !----------------------------------------------------------------------!
460     ! Subroutine: BACKUP_RES                                               !
461     ! Purpose: Shift existing RES file backup files by one index, then     !
462     ! create a copy of the current RES file.                               !
463     !----------------------------------------------------------------------!
464           SUBROUTINE BACKUP_RES
465     
466           use compar, only: myPE, PE_IO
467           use output, only: RES_BACKUPS
468           use discretelement, only: DISCRETE_ELEMENT
469           use param1, only: UNDEFINED_I
470     
471           IMPLICIT NONE
472     
473           CHARACTER(len=256) :: FNAME0, FNAME1
474     
475           INTEGER :: LC
476     
477           IF(myPE /= PE_IO) RETURN
478           IF(RES_BACKUPS == UNDEFINED_I) RETURN
479     
480     ! Shift all the existing backups by one.
481           DO LC=RES_BACKUPS,2,-1
482              CALL SET_FNAME(FNAME0,'.RES', LC-1)
483              CALL SET_FNAME(FNAME1,'.RES', LC)
484              CALL SHIFT_RES(FNAME0, FNAME1, 'mv')
485     
486              IF(DISCRETE_ELEMENT) THEN
487                 CALL SET_FNAME(FNAME0,'_DES.RES', LC-1)
488                 CALL SET_FNAME(FNAME1,'_DES.RES', LC)
489                 CALL SHIFT_RES(FNAME0, FNAME1, 'mv')
490              ENDIF
491           ENDDO
492     
493     ! Copy RES to RES1
494           CALL SET_FNAME(FNAME0, '.RES')
495           CALL SET_FNAME(FNAME1, '.RES' ,1)
496           CALL SHIFT_RES(FNAME0, FNAME1, 'cp')
497     
498           IF(DISCRETE_ELEMENT) THEN
499              CALL SET_FNAME(FNAME0, '_DES.RES')
500              CALL SET_FNAME(FNAME1, '_DES.RES' ,1)
501              CALL SHIFT_RES(FNAME0, FNAME1, 'cp')
502           ENDIF
503     
504           RETURN
505     
506           contains
507     
508     !----------------------------------------------------------------------!
509     ! Subroutine: SHIFT_RES                                                !
510     ! Purpose: Shift RES(LC-1) to RES(LC)                                  !
511     !----------------------------------------------------------------------!
512           SUBROUTINE SHIFT_RES(pFN0, pFN1, ACT)
513     
514           implicit none
515     
516           CHARACTER(LEN=*), INTENT(IN) :: pFN0, pFN1, ACT
517           CHARACTER(len=1024) :: CMD
518           LOGICAL :: EXISTS
519     
520           INQUIRE(FILE=trim(pFN0),EXIST=EXISTS)
521           IF(EXISTS) THEN
522              CMD=''; WRITE(CMD,1000)trim(ACT), trim(pFN0),trim(pFN1)
523              CALL SYSTEM(trim(CMD))
524           ENDIF
525     
526      1000 FORMAT(A,1x,A,1X,A)
527     
528           RETURN
529           END SUBROUTINE SHIFT_RES
530     
531     !----------------------------------------------------------------------!
532     ! Subroutine: SET_FNAME                                                !
533     ! Purpose: Set the backup RES file name based on pINDX.                !
534     !----------------------------------------------------------------------!
535           SUBROUTINE SET_FNAME(pFNAME, pEXT, pINDX)
536     
537           use run, only: RUN_NAME
538     
539           implicit none
540     
541           CHARACTER(LEN=*), INTENT(OUT) :: pFNAME
542           CHARACTER(LEN=*), INTENT(IN) ::  pEXT
543           INTEGER, INTENT(IN), OPTIONAL :: pINDX
544     
545     ! Set the file format for backup copies
546           pFNAME=''
547           IF(.NOT.PRESENT(pINDX)) THEN
548              WRITE(pFNAME,1000) trim(RUN_NAME),pEXT
549           ELSE
550              IF(RES_BACKUPS < 10) THEN
551                 WRITE(pFNAME,1001) trim(RUN_NAME), pEXT, pINDX
552              ELSEIF(RES_BACKUPS < 100) THEN
553                 WRITE(pFNAME,1002) trim(RUN_NAME), pEXT, pINDX
554              ELSEIF(RES_BACKUPS < 1000) THEN
555                 WRITE(pFNAME,1003) trim(RUN_NAME), pEXT, pINDX
556              ELSEIF(RES_BACKUPS < 10000) THEN
557                 WRITE(pFNAME,1004) trim(RUN_NAME), pEXT, pINDX
558              ELSEIF(RES_BACKUPS < 10000) THEN
559                 WRITE(pFNAME,1005) trim(RUN_NAME), pEXT, pINDX
560              ELSE
561                 WRITE(pFNAME,1006) trim(RUN_NAME), pEXT, pINDX
562              ENDIF
563           ENDIF
564     
565      1000 FORMAT(2A)
566      1001 FORMAT('BACKUP_RES/',2A,I1.1)
567      1002 FORMAT('BACKUP_RES/',2A,I2.2)
568      1003 FORMAT('BACKUP_RES/',2A,I3.3)
569      1004 FORMAT('BACKUP_RES/',2A,I4.4)
570      1005 FORMAT('BACKUP_RES/',2A,I5.5)
571      1006 FORMAT('BACKUP_RES/',2A,I6.6)
572     
573           RETURN
574           END SUBROUTINE SET_FNAME
575     
576           END SUBROUTINE BACKUP_RES
577     END MODULE output_man
578