SUBROUTINE MAKBND(INFIL,OUTFIL,ERRCD,ERRMSG) C C FUNCTION: CF CF C USAGE: CU CU C INPUTS: CI CI C OUTPUTS: CO CO C ALGORITHM: CA CA C MACHINE DEPENDENCIES: CM CM C HISTORY: CH CH written by: CH date: CH current version: CH modifications: CH added dpcom: 7/16/88 jdb CH C ROUTINES CALLED: CC CC C COMMON MEMORY USED: CM CM DPCOM -- see dpcommon.f and dpcom.f CM C---------------------------------------------------------------------- C written for: The CASCADE Project C Oak Ridge National Laboratory C U.S. Department of Energy C contract number DE-AC05-840R21400 C subcontract number 37B-07685C S13 C organization: The University of Tennessee C---------------------------------------------------------------------- C THIS SOFTWARE IS IN THE PUBLIC DOMAIN C NO RESTRICTIONS ON ITS USE ARE IMPLIED C---------------------------------------------------------------------- C C INCLUDE 'Parameter.f' C CHARACTER*(*) INFIL CHARACTER*(*) OUTFIL CHARACTER*(*) ERRMSG C DOUBLE PRECISION BOUND DOUBLE PRECISION FREQ DOUBLE PRECISION WNMIN DOUBLE PRECISION WNMAX DOUBLE PRECISION MINFRQ DOUBLE PRECISION MAXFRQ C DOUBLE PRECISION X DOUBLE PRECISION WCMAX C INTEGER ERRCD INTEGER NBNDH INTEGER NBNDL C INCLUDE 'dpcom.f' C ERRCD=0 C C--read in the bounds C OPEN (UNIT=UNIT1,FILE=INFIL,STATUS='OLD',ERR=9999) C C--open the new bounds-format file C OPEN (UNIT=UNIT2,FILE=OUTFIL,ERR=9998) C MINFRQ = 1.D30 MAXFRQ = 0.D0 READ (UNIT1,*,END=9999,ERR=9999) WNMIN,WNMAX READ (UNIT1,*,END=9999,ERR=9999) NBNDL DO 10, I = 1, NBNDL READ (UNIT1,*,END=9999,ERR=9999) BOUND,FREQ MINFRQ = MIN(MINFRQ,FREQ) MAXFRQ = MAX(MAXFRQ,FREQ) 10 CONTINUE READ (UNIT1,*,END=9999,ERR=9999) NBNDH C C--calculate wcmax C WCMAX = 1.D30 C DO 20, I = 1, NBNDH READ (UNIT1,*,END=9999,ERR=9999) BOUND,FREQ MINFRQ = MIN(MINFRQ,FREQ) MAXFRQ = MAX(MAXFRQ,FREQ) IF (BOUND .GE. 0.0D0) THEN X = FREQ * 10.D0 ** (- BOUND/20.D0) IF (X .LT. WCMAX) WCMAX = X END IF 20 CONTINUE C C--rewind input file C REWIND UNIT1 C C--calculate min_plot_frequency, max_plot_frequency C MINFRQ=0.1D0*MIN(MINFRQ,WNMIN) MAXFRQ=10.D0*MAX(MAXFRQ,WNMAX) C C--ensure that wcmax isn't unreasonable, caused by foolish bounds C WCMAX = MIN(WCMAX,MAXFRQ) C C--write bounds file C WRITE (UNIT2,*,ERR=9998) MINFRQ,MAXFRQ READ (UNIT1,*,ERR=9999) WNMIN,WNMAX C C--copy input file to output file C READ (UNIT1,*,ERR=9999) NBNDL WRITE (UNIT2,*,ERR=9998) NBNDL DO 30, I = 1, NBNDL READ (UNIT1,*,ERR=9999) BOUND,FREQ WRITE (UNIT2,*,ERR=9998) BOUND,FREQ 30 CONTINUE READ (UNIT1,*,ERR=9999) NBNDH WRITE (UNIT2,*,ERR=9998) NBNDH DO 40, I = 1, NBNDH READ (UNIT1,*,ERR=9999) BOUND,FREQ WRITE (UNIT2,*,ERR=9998) BOUND,FREQ 40 CONTINUE C C--write wcmax to output file C WRITE (UNIT2,*,ERR=9998) WCMAX C C--close files and end C CLOSE (UNIT=UNIT1) CLOSE (UNIT=UNIT2) RETURN C C--i/o errors and eof come here C 9998 ERRCD=2 ERRMSG = 'MAKBND: Fatal error writing to '//OUTFIL CLOSE (UNIT=UNIT1) CLOSE (UNIT=UNIT2) RETURN 9999 ERRCD=1 ERRMSG = 'MAKBND: Fatal error reading from '//INFIL CLOSE (UNIT=UNIT1) CLOSE (UNIT=UNIT2) RETURN END