```c   This program performs power calculations
c   for a proposed ASTM plastic lumber standard.
c
c   Steve Verrill, 3/25/99
c
c
c

real xfifth(5),cv(5),probf(5,5)

integer icv(5),fifth(5)

real*8 tval,pf,xncp

real*8 tolk

character*80 results

character*80 argv,intwrite

call getarg(6,results)

open(unit=7,file=results,access="append",status="unknown")

call getarg(7,results)

write(6,9900) results
9900 format("The results from this run have been appended to",
x       " the file `",a80,"`To see how to download",
x       " this file,",
x       ' read this description of anonymous ftp',
x       '.','Alternatively, you should be able to do a',
x       ' "Save As" or "Print" in your browser.')

write(7,9700)
9700 format(////,1x,"**************************************",//,1x,
x               "Output from astmplast3.f",//,1x,
x               "**************************************",/)

c
c   flexural stress fifth percentiles
c

call getarg(1,argv)
write(intwrite,7) argv
7    format(a80)

call getarg(2,argv)
write(intwrite,7) argv

do 40 i = 1,numfifth

xfifth(i) = fifth(i)

40   continue

c
c   cvs
c

call getarg(3,argv)
write(intwrite,7) argv

call getarg(4,argv)
write(intwrite,7) argv

do 55 i = 1,numcv

cv(i) = abs(icv(i)/100.0)

if ((cv(i) .eq. 0.0) .or. (cv(i) .ge. 1.0)) then

write(6,54)
54         format("A coefficient of variation value",
x      " did not lie between 0 and 100.  Please correct",
x      " the form.")

stop

endif

55   continue

c
c   number of specimens
c

call getarg(5,argv)
write(intwrite,7) argv
idof = num - 1
xn = num

write(6,61) num
write(7,62) num
61   format('These calculations assume that flexural stress',
x' is normally distributed, and that ',i3,' specimens',
x' will be tested.')
62   format(/,1x,'These calculations assume that flexural stress',
x' is normally distributed,',/,1x,
x'and that ',i3,' specimens will be tested.',/)

c
c   Calculate the k value
c

ier = 0
xk = tolk(num,ier)

if (ier .ne. 1) then

write(6,65) ier
write(7,66) ier
65      format('Error 65: The ierror value was ',i3,'.',
x   '',
x   'sverrill@fs.fed.us.')
66      format(/,1x,'Error 66:  The ierror value was ',
x   'at sverrill@fs.fed.us.',/)

stop

endif

c
c   perform the power calculations
c

fac = sqrt(xn)
tval = xk*fac

do 110 i = 1,numcv

den = 1.0 - 1.645*cv(i)

do 100 j = 1,numfifth

xmu = xfifth(j)/den
xncp = fac*(xmu - 1000.0)/
x             (xmu*cv(i))

c            write(6,90) i,j,fac,xfifth(j),cv(i),xncp
c 90         format("The i,j,fac,xfifth(j),cv(i),xncp",
c     x      " values are",i1,2x,i1,2x,4(e12.4,2x),
c     x      "")

ier = 0

c            write(6,90) tval,idof,xncp,pf,ier
c 90         format('tval, idof, xncp, pf, and ier equal',
c     x      e12.4,2x,i2,2x,e12.4,2x,e12.4,2x,i2,'.')

call mdtn(tval,idof,xncp,pf,ier)

if (ier .ne. 0) then

write(6,81) ier
write(7,82) ier
81            format('Error 81: istatus = ',i2,'.',
x         '',
x         'sverrill@fs.fed.us.')
82            format(/,1x,'Error 81: istatus = ',i2,'.',/,
x         ' steve@swst.org.',/)

stop

endif

probf(i,j) = pf

100     continue

110  continue

c      write(6,115)
c 115  format("Got to 115.")

write(6,1010)
write(7,1012) (fifth(i), i = 1,numfifth)
1010 format('Fifth percentiles are on top.  Coefficients',
x' of variation are along the left side.  Probabilities',
x' of failing the test are in the table.')
1012 format(///,1x,'Fifth percentiles are on top.  Coefficients of',
x' variation',/,1x,'are along the left side.  ',
x'Probabilities of failing the test',/,1x,'are in the table.',
x//,
x5x,5(2x,i6),/)

do 1016 i = 1,numcv
write(7,1014) icv(i),(probf(i,j),j = 1,numfifth)
1014    format(2x,i3,5(3x,f5.3))
1016 continue

write(6,1020)
1020 format("")

write(6,1030) numfifth
1030 format("",
x"")
do 1034 i = 1,numfifth
write(6,1032) fifth(i)
1032    format("")
1034 continue
write(6,1036)
1036 format("")

do 1050 i = 1,numcv

write(6,1042) icv(i),(probf(i,j), j = 1,numfifth)
1042    format("","",(""))

write(6,1044)
1044    format("")

1050 continue

write(6,1052)
1052 format("Coefficientofvariation Fifth percentile  ",i6,"",i3,"",f5.3,"")

write(6,6060)
6060 format('For further information,',
x'',
x'sverrill@fs.fed.us',

stop

end

c
c
c
double precision function tolk(n,ier)
c
c
c   Steve Verrill, 1/15/93
c   modified for this ASTM problem on 3/28/99
c
c   This routine calculates the k needed to obtain
c   the parametric tolerance bound on the fifth percentile
c
c
c
implicit double precision (a-h,o-z)
c
xn = n
srn = sqrt(xn)
c
xncp = 1.645*srn
c
idf = n - 1

call tinv(.75d0,tval,idf,xncp,ier)
c
tolk = tval/srn
c
return
c
end
```