* F08ZBF Example Program Text * Mark 17 Release. NAG Copyright 1995. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER MMAX, NB, NMAX, PMAX PARAMETER (MMAX=10,NB=64,NMAX=10,PMAX=10) INTEGER LDA, LDB, LWORK PARAMETER (LDA=NMAX,LDB=NMAX,LWORK=MMAX+NMAX+NB*(NMAX+PMAX) + ) * .. Local Scalars .. DOUBLE PRECISION RNORM INTEGER I, INFO, J, M, N, P * .. Local Arrays .. DOUBLE PRECISION A(LDA,MMAX), B(LDB,PMAX), D(NMAX), WORK(LWORK), + X(MMAX), Y(PMAX) * .. External Functions .. DOUBLE PRECISION DNRM2 EXTERNAL DNRM2 * .. External Subroutines .. EXTERNAL DGGGLM * .. Executable Statements .. WRITE (NOUT,*) 'F08ZBF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) N, M, P IF (M.LE.MMAX .AND. N.LE.NMAX .AND. P.LE.PMAX) THEN * * Read A, B and D from data file * READ (NIN,*) ((A(I,J),J=1,M),I=1,N) READ (NIN,*) ((B(I,J),J=1,P),I=1,N) READ (NIN,*) (D(I),I=1,N) * * Solve the weighted least squares problem * * minimize ||inv(B)*(d - A*x)|| (in the 2-norm) * CALL DGGGLM(N,M,P,A,LDA,B,LDB,D,X,Y,WORK,LWORK,INFO) * * Print least squares solution, x * WRITE (NOUT,*) 'Weighted least-squares solution' WRITE (NOUT,99999) (X(I),I=1,M) * * Print residual vector y = inv(B)*(d - A*x) * WRITE (NOUT,*) WRITE (NOUT,*) 'Residual vector' WRITE (NOUT,99998) (Y(I),I=1,P) * * Compute and print the square root of the residual sum of * squares * RNORM = DNRM2(P,Y,1) * WRITE (NOUT,*) WRITE (NOUT,*) 'Square root of the residual sum of squares' WRITE (NOUT,99998) RNORM ELSE WRITE (NOUT,*) + 'One or more of MMAX, NMAX and PMAX is too small' END IF STOP * 99999 FORMAT (1X,7F11.4) 99998 FORMAT (3X,1P,7E11.2) END