* G03DBF Example Program Text * Mark 15 Release. NAG Copyright 1991. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX, MMAX, LDGMN, LDX, LDD PARAMETER (NMAX=21,MMAX=2,LDGMN=3,LDX=NMAX,LDD=NMAX) * .. Local Scalars .. DOUBLE PRECISION DF, SIG, STAT INTEGER I, IFAIL, J, M, N, NG, NOBS, NVAR CHARACTER EQUAL, WEIGHT * .. Local Arrays .. DOUBLE PRECISION D(LDD,LDGMN), DET(LDGMN), + GC((LDGMN+1)*MMAX*(MMAX+1)/2), GMN(LDGMN,MMAX), + WK(NMAX*(MMAX+1)), WT(NMAX), X(LDX,MMAX) INTEGER ING(NMAX), ISX(MMAX), IWK(LDGMN), NIG(LDGMN) * .. External Subroutines .. EXTERNAL G03DAF, G03DBF * .. Executable Statements .. WRITE (NOUT,*) 'G03DBF Example Program Results' * Skip headings in data file READ (NIN,*) READ (NIN,*) N, M, NVAR, NG, WEIGHT IF (N.LE.NMAX .AND. M.LE.MMAX) THEN IF (WEIGHT.EQ.'W' .OR. WEIGHT.EQ.'w') THEN DO 20 I = 1, N READ (NIN,*) (X(I,J),J=1,M), ING(I), WT(I) 20 CONTINUE ELSE DO 40 I = 1, N READ (NIN,*) (X(I,J),J=1,M), ING(I) 40 CONTINUE END IF READ (NIN,*) (ISX(J),J=1,M) IFAIL = 1 * CALL G03DAF(WEIGHT,N,M,X,LDX,ISX,NVAR,ING,NG,WT,NIG,GMN,LDGMN, + DET,GC,STAT,DF,SIG,WK,IWK,IFAIL) * IF (IFAIL.EQ.0) THEN READ (NIN,*) NOBS, EQUAL IF (NOBS.LE.NMAX) THEN DO 60 I = 1, NOBS READ (NIN,*) (X(I,J),J=1,M) 60 CONTINUE IFAIL = 1 * CALL G03DBF(EQUAL,'Sample points',NVAR,NG,GMN,LDGMN,GC, + NOBS,M,ISX,X,LDX,D,LDD,WK,IFAIL) * IF (IFAIL.EQ.0) THEN WRITE (NOUT,*) WRITE (NOUT,*) ' Obs Distances' WRITE (NOUT,*) DO 80 I = 1, NOBS WRITE (NOUT,99999) I, (D(I,J),J=1,NG) 80 CONTINUE ELSE WRITE (NOUT,*) WRITE (NOUT,99998) ' ** G03DBF returned with IFAIL = ' + , IFAIL END IF END IF ELSE WRITE (NOUT,*) WRITE (NOUT,99998) ' ** G03DAF returned with IFAIL = ', + IFAIL END IF END IF * 99999 FORMAT (1X,I3,3F10.3) 99998 FORMAT (1X,A,I5) END