Program g01jcfe ! G01JCF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. 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