! ManualPerm
! program to do a manual (i.e. keyboard data) permutation test
! written by Tim Mitchell on 9.10.00
! last modified on 10.10.00
! f90 -o manualperm sortmod.f90 arraymod.f90 permmod.f90 manualperm.f90

program ManualPerm

use PermMod

implicit none

real, pointer, dimension (:) 	:: ConVec, SusVec

real, parameter :: MissVal = -999.0

real :: Prob, Rand

integer :: ReadStatus, AllocStat
integer :: PossN, PoolN, SusN, ConN, IdealSize
integer :: XMem, XPoss, XCon, XSus

!*******************************************************************************
! get data

open (99,file="/cru/u2/f709762/data/scratch/log-manp.dat",status="replace",action="write")

print*, "  > Enter the sizes of control and suspected samples:"
do
	read (*,*,iostat=ReadStatus), ConN, SusN
	if (ReadStatus.LE.0) exit
end do

allocate (ConVec(ConN), &
	  SusVec(SusN), stat=AllocStat)
if (AllocStat.NE.0) print*, "  > ##### ERROR: TestPValue: Allocation failure #####"

print*, "  > Enter the values in the control sample: "
do XCon = 1, ConN
  do
	read (*,*,iostat=ReadStatus), ConVec (XCon)
	if (ReadStatus.NE.0) print*, "  > Unacceptable entry. Retry."
	if (ReadStatus.LE.0) exit
  end do
end do

print*, "  > Enter the values in the suspect sample: "
do XSus = 1, SusN
  do
	read (*,*,iostat=ReadStatus), SusVec (XSus)
	if (ReadStatus.NE.0) print*, "  > Unacceptable entry. Retry."
	if (ReadStatus.LE.0) exit
  end do
end do

PoolN = ConN + SusN			! pooled sample

PossN = 0 				! total permutations in pooled sample 
do XMem	= PoolN, (PoolN - SusN + 1), -1
  if (PossN.EQ.0) then
  	PossN = XMem
  else
  	PossN = PossN * XMem
  end if
end do

print*, "  > Pooled sample, and possible permutations: ", PoolN, PossN

print*, "  > Enter the ideal sample size: "
do
	read (*,*,iostat=ReadStatus), IdealSize
	if (ReadStatus.LE.0) exit
end do

!*******************************************************************************
! do calculation

print*, "  > Calculating..."
Prob = PValue (ConVec,SusVec,100,IdealSize)

deallocate (ConVec,SusVec)

print "(f10.4)", Prob
print*

close (99)

end program ManualPerm