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) read(intwrite,*) numfifth call getarg(2,argv) write(intwrite,7) argv read(intwrite,*) (fifth(i),i = 1,numfifth) do 40 i = 1,numfifth xfifth(i) = fifth(i) 40 continue c c cvs c call getarg(3,argv) write(intwrite,7) argv read(intwrite,*) numcv call getarg(4,argv) write(intwrite,7) argv read(intwrite,*) (icv(i),i = 1,numcv) 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 read(intwrite,*) num 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 ' Please contact Steve Verrill at ', x '', x 'sverrill@fs.fed.us.

') 66 format(/,1x,'Error 66: The ierror value was ', x i3,'. Please contact Steve Verrill',/,1x, 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 'Please contact Steve Verrill at ', x '', x 'sverrill@fs.fed.us.
') 82 format(/,1x,'Error 81: istatus = ',i2,'.',/, x 1x,'Please contact Steve Verrill at', 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("
Coefficient
of
variation
Fifth percentile
",i6,"
",i3,"",f5.3,"
") write(6,6060) 6060 format('



For further information,', x' please contact Steve Verrill at ', x'', x'sverrill@fs.fed.us', x' or 608-231-9375.
Last modified on 3/28/99.') 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