PROGRAM g01jcfe ! G01JCF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g01jcf, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. REAL (KIND=nag_wp) :: c, p, pdf, tol INTEGER :: i, ifail, lwrk, maxit, n, pn ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: a(:), rlamda(:), wrk(:) INTEGER, ALLOCATABLE :: mult(:) ! .. Executable Statements .. WRITE (nout,*) 'G01JCF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Display titles WRITE (nout,*) ' A MULT RLAMDA' WRITE (nout,*) ! Use default tolerance tol = 0.0E0_nag_wp maxit = 500 ! Dummy allocation for the arrays ALLOCATE (a(1),rlamda(1),mult(1),wrk(1)) pn = 0 D_LP: DO READ (nin,*,IOSTAT=ifail) n, c IF (ifail/=0) THEN EXIT D_LP END IF ! Reallocate arrays if required IF (pn/=n) THEN DEALLOCATE (a,rlamda,mult,wrk) lwrk = n + 2*maxit ALLOCATE (a(n),rlamda(n),mult(n),wrk(lwrk)) END IF pn = n ! Read in weights, degrees of freedom and distribution parameter READ (nin,*) a(1:n) READ (nin,*) mult(1:n) READ (nin,*) rlamda(1:n) ! Calculate probability ifail = -1 CALL g01jcf(a,mult,rlamda,n,c,p,pdf,tol,maxit,wrk,ifail) IF (ifail/=0) THEN IF (ifail<4) THEN EXIT D_LP END IF END IF ! Display results WRITE (nout,99999) (a(i),mult(i),rlamda(i),i=1,n) WRITE (nout,99998) 'C = ', c, ' PROB =', p END DO D_LP 99999 FORMAT (1X,F10.2,I6,F9.2) 99998 FORMAT (1X,A,F6.2,A,F7.4) END PROGRAM g01jcfe