* G01ABF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. INTEGER NMAX PARAMETER (NMAX=30) INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) * .. Local Scalars .. INTEGER I, IFAIL, IWT, J, N, NPROB * .. Local Arrays .. DOUBLE PRECISION RES(13), WT(NMAX), WTIN(NMAX), X1(NMAX), X2(NMAX) * .. External Subroutines .. EXTERNAL DCOPY, G01ABF * .. Executable Statements .. WRITE (NOUT,*) 'G01ABF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*) NPROB DO 20 J = 1, NPROB READ (NIN,*) N, IWT WRITE (NOUT,*) WRITE (NOUT,99999) 'Problem ', J WRITE (NOUT,99999) 'Number of cases', N IF (N.GE.1 .AND. N.LE.NMAX) THEN READ (NIN,*) (X1(I),X2(I),I=1,N) IF (IWT.EQ.1) THEN READ (NIN,*) (WTIN(I),I=1,N) CALL DCOPY(N,WTIN,1,WT,1) END IF IFAIL = 1 * CALL G01ABF(N,X1,X2,IWT,WT,RES,IFAIL) * IF (IFAIL.GE.0) THEN WRITE (NOUT,*) 'Data as input -' WRITE (NOUT,99993) WRITE (NOUT,99995) (X1(I),X2(I),I=1,N) IF (IWT.EQ.1) THEN WRITE (NOUT,*) 'Weights as input -' WRITE (NOUT,99994) (WTIN(I),I=1,N) END IF WRITE (NOUT,*) END IF IF (IFAIL.EQ.0) THEN WRITE (NOUT,*) 'Successful call of G01ABF' WRITE (NOUT,99999) 'No. of valid cases', IWT WRITE (NOUT,99992) 'Variable 1', 'Variable 2' WRITE (NOUT,99998) 'Mean ', RES(1), RES(2) WRITE (NOUT,99998) 'Std devn', RES(3), RES(4) WRITE (NOUT,99997) 'Corr SSP', RES(5), RES(6), RES(7) WRITE (NOUT,99996) 'Correln ', RES(8) WRITE (NOUT,99998) 'Minimum ', RES(9), RES(11) WRITE (NOUT,99998) 'Maximum ', RES(10), RES(12) WRITE (NOUT,99998) 'Sum of weights ', RES(13) ELSE IF (IFAIL.GT.0) THEN WRITE (NOUT,*) 'Unsuccessful call of G01ABF' WRITE (NOUT,99999) 'IFAIL =', IFAIL IF (IFAIL.EQ.2) THEN WRITE (NOUT,99999) 'No. of valid cases', IWT WRITE (NOUT,99992) 'Variable 1', 'Variable 2' WRITE (NOUT,99998) 'Mean ', RES(1), RES(2) WRITE (NOUT,99997) 'Corr SSP', RES(5), RES(6), RES(7) WRITE (NOUT,99998) 'Minimum ', RES(9), RES(11) WRITE (NOUT,99998) 'Maximum ', RES(10), RES(12) WRITE (NOUT,99998) 'Sum of weights ', RES(13) END IF ELSE WRITE (NOUT,99991) IFAIL GO TO 40 END IF ELSE GO TO 40 END IF 20 CONTINUE 40 CONTINUE * 99999 FORMAT (1X,A,I5) 99998 FORMAT (1X,A,F15.1,F30.1) 99997 FORMAT (1X,A,3E15.5) 99996 FORMAT (1X,A,F30.4) 99995 FORMAT (5X,6F11.1) 99994 FORMAT (13X,F9.3) 99993 FORMAT (4X,3(4X,'Var',2X,'1',4X,'Var',2X,'2')) 99992 FORMAT (13X,A,20X,A) 99991 FORMAT (1X,/1X,' ** G01ABF returned with IFAIL = ',I5) END