* F08YHF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER MMAX, NMAX PARAMETER (MMAX=8,NMAX=8) INTEGER LDA, LDB, LDC, LDD, LDE PARAMETER (LDA=MMAX,LDB=NMAX,LDC=MMAX,LDD=MMAX,LDE=NMAX) INTEGER LDF, LWORK PARAMETER (LDF=MMAX,LWORK=1) * .. Local Scalars .. DOUBLE PRECISION DIF, SCALE INTEGER I, IFAIL, IJOB, INFO, J, M, N * .. Local Arrays .. DOUBLE PRECISION A(LDA,MMAX), B(LDB,NMAX), C(LDC,NMAX), + D(LDD,MMAX), E(LDE,NMAX), F(LDF,NMAX), + WORK(LWORK) INTEGER IWORK(MMAX+NMAX+6) * .. External Subroutines .. EXTERNAL DTGSYL, X04CAF * .. Executable Statements .. WRITE (NOUT,*) 'F08YHF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) M, N IF (M.LE.MMAX .AND. N.LE.NMAX) THEN * * Read A, B, D, E, C and F from data file * READ (NIN,*) ((A(I,J),J=1,M),I=1,M) READ (NIN,*) ((B(I,J),J=1,N),I=1,N) READ (NIN,*) ((D(I,J),J=1,M),I=1,M) READ (NIN,*) ((E(I,J),J=1,N),I=1,N) READ (NIN,*) ((C(I,J),J=1,N),I=1,M) READ (NIN,*) ((F(I,J),J=1,N),I=1,M) * * Solve the Sylvester equations * A*R - L*B = scale*C and D*R - L*E = scale*F * for R and L. * IJOB = 0 CALL DTGSYL('No transpose',IJOB,M,N,A,LDA,B,LDB,C,LDC,D,LDD,E, + LDE,F,LDF,SCALE,DIF,WORK,LWORK,IWORK,INFO) IF (INFO.GE.1) THEN WRITE (NOUT,99999) WRITE (NOUT,*) END IF * * Print the solution matrices R and L * IFAIL = 0 CALL X04CAF('General',' ',M,N,C,LDC,'Solution matrix R',IFAIL) * WRITE (NOUT,*) IFAIL = 0 CALL X04CAF('General',' ',M,N,F,LDF,'Solution matrix L',IFAIL) * WRITE (NOUT,*) WRITE (NOUT,99998) 'SCALE = ', SCALE ELSE WRITE (NOUT,*) 'MMAX and/or NMAX too small' END IF STOP * 99999 FORMAT (/' (A,D) and (B,E) have common or very close ','eigenval', + 'ues.',/' Perturbed values were used to solve ','the equa', + 'tions') 99998 FORMAT (1X,A,1P,E10.2) END