SUBROUTINE LQRFWC(SYSFIL,BALFIL,BNDFIL,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 corrected real,cmplx: 7/27/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*(*) SYSFIL CHARACTER*(*) BALFIL CHARACTER*(*) BNDFIL CHARACTER*(*) OUTFIL CHARACTER*(*) ERRMSG C DOUBLE PRECISION A(SIZE,SIZE) DOUBLE PRECISION B(SIZE,SIZE) DOUBLE COMPLEX W(SIZE) DOUBLE COMPLEX C(SIZE,SIZE) DOUBLE PRECISION CC(SIZE,SIZE) DOUBLE PRECISION D(SIZE,SIZE) DOUBLE COMPLEX RV1(SIZE) DOUBLE PRECISION Q(SIZE,SIZE) DOUBLE COMPLEX U(SIZE,SIZE) DOUBLE COMPLEX V(SIZE,SIZE) DOUBLE COMPLEX WORK(SIZE) DOUBLE PRECISION SIGMAX DOUBLE PRECISION SIGMIN DOUBLE PRECISION WMNMXP DOUBLE PRECISION BOUND DOUBLE PRECISION FREQ DOUBLE PRECISION WCMIN DOUBLE COMPLEX CB(SIZE,SIZE) DOUBLE PRECISION X,Y C DOUBLE PRECISION DREAL DOUBLE COMPLEX DCMPLX C INTEGER NBNDL INTEGER NSTATS INTEGER NINPS INTEGER NOUTS INTEGER ERRCD INTEGER IERR C INCLUDE 'dpcom.f' C OPEN (UNIT=UNIT8,FILE=BNDFIL,STATUS='OLD',ERR=9990) READ (UNIT8,*,END=9990,ERR=9990) X,Y READ (UNIT8,*,END=9990,ERR=9990) NBNDL READ (UNIT8,*,END=9990,ERR=9990) BOUND,FREQ WCMIN = 10.0D0 ** (BOUND/20.0D0) * FREQ NBNDL = NBNDL - 1 10 IF (NBNDL .GT. 0) THEN READ (UNIT8,*,END=9990,ERR=9990) BOUND,FREQ WCMIN = MIN (WCMIN,10.0D0 ** (BOUND/20.0D0) * FREQ) NBNDL = NBNDL - 1 GO TO 10 END IF CLOSE (UNIT=UNIT8) C CALL INSYS(SYSFIL,NINPS,NOUTS,NSTATS, 2 SIZE,SIZE,SIZE,A,B,CC,D,ERRCD) CLOSE (UNIT=UNIT1) IF (ERRCD .NE. 0) THEN ERRMSG = 'LQRFWC: Fatal error from INSYS '// 1 'accessing '//SYSFIL RETURN END IF C OPEN (UNIT=UNIT8,FILE=BALFIL,STATUS='OLD',ERR=9991) C DO 20,I = 1, NINPS READ (UNIT8,*,ERR=9991) (C(I,J),J=1, NSTATS) 20 CONTINUE C DO 30,I = 1, NSTATS READ (UNIT8,*,ERR=9991) (Q(I,J),J=1, NSTATS) 30 CONTINUE C CLOSE (UNIT=UNIT8) C C--now find maximum singular value at crossover to determine rho C DO 33 I = 1, NINPS DO 32 J = 1, NINPS CB(J,I) = DCMPLX(0.0D0,0.0D0) DO 31 K = 1, NSTATS CB(J,I) = CB(J,I) + C(J,K)*B(K,I) 31 CONTINUE 32 CONTINUE 33 CONTINUE C C CALL MMUL (SIZE,SIZE,SIZE,NINPS,NSTATS,NINPS,C,B,CB) C CALL SVD (SIZE,NINPS,NINPS,CB,W,.FALSE., C 2 U,.FALSE.,V,IERR,RV1) CALL ZSVDC(CB,SIZE,NINPS,NINPS,W,RV1,U,SIZE, 1 V,SIZE,WORK,0,IERR) IF (IERR.NE.0) THEN ERRCD = 100 + IERR ERRMSG = 'LQRFWC: Fatal error from '// 1 'DSVDC. ERRCD = 100 + INFO, where '// 2 'INFO is returned from DSVDC.' RETURN END IF SIGMAX = DREAL(W(1)) SIGMIN = DREAL(W(1)) DO 71 I = 1, NINPS IF (DREAL(W(I)) .LT. 1.D-10) GO TO 71 IF (SIGMAX .LT. DREAL(W(I))) SIGMAX = DREAL(W(I)) IF (SIGMIN .GT. DREAL(W(I))) SIGMIN = DREAL(W(I)) 71 CONTINUE IF (SIGMIN .LT. 1.D-10) THEN WMNMXP = 1.0D0 ELSE WMNMXP = SIGMIN / SIGMAX END IF C OPEN (UNIT=UNIT8,FILE=OUTFIL,ERR=9992) C WRITE (UNIT8,*,ERR=9992) WCMIN, SIGMAX, WMNMXP C CLOSE (UNIT=UNIT8) C C-- THE END C RETURN C C--error handling C 9990 ERRCD = 1 ERRMSG = 'LQRFWC: Fatal error accessing '// 2 'the bounds file '//BNDFIL CLOSE (UNIT=UNIT8) RETURN 9991 ERRCD = 2 ERRMSG = 'LQRFWC: Fatal error accessing '// 2 'the balancing file '//BALFIL CLOSE (UNIT=UNIT8) RETURN 9992 ERRCD = 3 ERRMSG = 'LQRFWC: Fatal error writing to '// 2 'the output file '//OUTFIL CLOSE (UNIT=UNIT8) RETURN END