PROGRAM g11bcfe ! G11BCF Example Program Text ! Mark 23 Release. NAG Copyright 2011. ! .. Use Statements .. USE nag_library, ONLY : g11bcf, nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nin = 5, nout = 6 ! .. Local Scalars .. INTEGER :: i, ifail, k, lauxt, maxst, mcells, & mdim, ncells, ncol, ndim, nrow CHARACTER (1) :: stat ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: auxt(:), stable(:), table(:), wk(:) INTEGER, ALLOCATABLE :: idim(:), isdim(:), iwk(:), mlevel(:) ! .. Executable Statements .. WRITE (nout,*) 'G11BCF Example Program Results' WRITE (nout,*) ! Skip heading in data file READ (nin,*) ! Read in the problem size READ (nin,*) stat, ncells, ndim ALLOCATE (table(ncells),idim(ndim),isdim(ndim)) ! Read in data READ (nin,*) table(1:ncells) READ (nin,*) idim(1:ndim) READ (nin,*) isdim(1:ndim) ! Calculate MAXST maxst = 1 DO i = 1, ndim IF (isdim(i)>0) THEN maxst = maxst*idim(i) END IF END DO IF (stat=='V' .OR. stat=='v') THEN lauxt = maxst ELSE lauxt = 0 END IF ALLOCATE (stable(maxst),mlevel(ndim),auxt(lauxt),iwk(3*ndim), & wk(ncells)) ! Compute marginal table ifail = 0 CALL g11bcf(stat,table,ncells,ndim,idim,isdim,stable,maxst,mcells,mdim, & mlevel,auxt,iwk,wk,ifail) ! Display results WRITE (nout,*) ' Marginal Table' WRITE (nout,*) ncol = mlevel(mdim) nrow = mcells/ncol k = 1 DO i = 1, nrow WRITE (nout,99999) stable(k:(k+ncol-1)) k = k + ncol END DO 99999 FORMAT (10F8.2) END PROGRAM g11bcfe