* G02CFF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. INTEGER N, LDSSP, LDR PARAMETER (N=3,LDSSP=N,LDR=N) INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) * .. Local Scalars .. INTEGER I, IFAIL, J * .. Local Arrays .. DOUBLE PRECISION R(LDR,N), SSP(LDSSP,N), STD(N), XBAR(N) INTEGER KORDER(N), KWORK(N) * .. External Subroutines .. EXTERNAL G02CFF * .. Executable Statements .. WRITE (NOUT,*) 'G02CFF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*) (XBAR(I),I=1,N), (STD(I),I=1,N), + ((SSP(I,J),J=1,N),I=1,N), ((R(I,J),J=1,N),I=1,N) WRITE (NOUT,*) WRITE (NOUT,99999) 'Original vector XBAR : ', (XBAR(I),I=1,N) WRITE (NOUT,*) WRITE (NOUT,99999) 'Original vector STD : ', (STD(I),I=1,N) WRITE (NOUT,*) WRITE (NOUT,*) 'Original matrix SSP :' WRITE (NOUT,99998) ((SSP(I,J),J=1,N),I=1,N) WRITE (NOUT,*) WRITE (NOUT,*) 'Original matrix R :' WRITE (NOUT,99998) ((R(I,J),J=1,N),I=1,N) WRITE (NOUT,*) KORDER(1) = 1 KORDER(2) = 3 KORDER(3) = 2 IFAIL = 1 * CALL G02CFF(N,KORDER,XBAR,STD,SSP,LDSSP,R,LDR,KWORK,IFAIL) * IF (IFAIL.NE.0) THEN WRITE (NOUT,*) WRITE (NOUT,99997) ' ** G02CFF returned with IFAIL = ', IFAIL ELSE WRITE (NOUT,99996) 'New vector XBAR : ', (XBAR(I),I=1,N) WRITE (NOUT,*) WRITE (NOUT,99996) 'New vector STD : ', (STD(I),I=1,N) WRITE (NOUT,*) WRITE (NOUT,*) 'New matrix SSP :' WRITE (NOUT,99995) ((SSP(I,J),J=1,N),I=1,N) WRITE (NOUT,*) WRITE (NOUT,*) 'New matrix R :' WRITE (NOUT,99995) ((R(I,J),J=1,N),I=1,N) END IF * 99999 FORMAT (1X,A,3F10.4) 99998 FORMAT (1X,3F10.4) 99997 FORMAT (1X,A,I5) 99996 FORMAT (1X,A,3F10.4) 99995 FORMAT (1X,3F10.4) END