Program f01bsfe ! F01BSF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: f01brf, f01bsf, nag_wp, x04abf ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: iset = 1, nin = 5, nout = 6 ! .. Local Scalars .. Real (Kind=nag_wp) :: eta, rpmin, u Integer :: i, ifail, licn, lirn, n, nz, outchn Logical :: grow, lblock ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: a(:), w(:) Integer, Allocatable :: icn(:), ikeep(:,:), irn(:), & ivect(:), iw(:,:), jvect(:) Integer :: idisp(10) Logical :: abort(4) ! .. Executable Statements .. Write (nout,*) 'F01BSF Example Program Results' outchn = nout ! Skip heading in data file Read (nin,*) Read (nin,*) n, nz licn = 3*nz lirn = 3*nz/2 Allocate (a(licn),w(n),icn(licn),ikeep(n,5),irn(lirn),ivect(nz),iw(n,8), & jvect(nz)) Call x04abf(iset,outchn) Write (nout,*) Read (nin,*)(a(i),irn(i),icn(i),i=1,nz) u = 0.1E0_nag_wp lblock = .True. grow = .True. abort(1) = .True. abort(2) = .True. abort(3) = .False. abort(4) = .True. ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 Call f01brf(n,nz,a,licn,irn,lirn,icn,u,ikeep,iw,w,lblock,grow,abort, & idisp,ifail) If (grow) Then Write (nout,*) 'On exit from F01BRF' Write (nout,99999) 'Value of W(1) = ', w(1) End If Read (nin,*)(a(i),ivect(i),jvect(i),i=1,nz) eta = 0.1E0_nag_wp ! ifail: behaviour on error exit ! =110 for noisy, hard exit ifail = 110 Call f01bsf(n,nz,a,licn,ivect,jvect,icn,ikeep,iw,w,grow,eta,rpmin, & abort(4),idisp,ifail) If (grow) Then Write (nout,*) Write (nout,*) 'On exit from F01BSF' Write (nout,99999) 'Value of W(1) = ', w(1) End If If (eta<1.0E0_nag_wp) Then Write (nout,*) Write (nout,99999) 'Value of RPMIN = ', rpmin End If 99999 Format (1X,A,F7.4) End Program f01bsfe