C**********************************************************
C                                                         *
C   COLOR TESTING HOST                                    *
C                                                         *
C**********************************************************
C
      PROGRAM TESTER

      INCLUDE "irreg.h"

      INTEGER i, ntimes, iter, seed, ncol, ntherm 

C
C-- Start up Express and find out if we need to swap bytes.
C
      CALL KXINIT
      ISWAP = KXTSWA()
      PGIND = KXRUN(NPROCS, 'node')
      IF(PGIND .LT. 0) THEN 
         WRITE(6,*) 'Failed to allocate nodes and load program.'
         CALL KXCLOS(PGIND)
         STOP
      ENDIF
      CALL KXPARA(ENV)

      CALL set_up_files

      WRITE(6,*) "Number of vertices ", n
      WRITE(6,*) "Number of processors ", NPROCS

C
C --- Read in parameters.
C

      WRITE(6,*) "Enter number of meshes to be colored"
      READ(5,*) ntimes
      WRITE(6,*) ntimes

      WRITE(6,*) "Enter number of colorings per mesh"
      READ(5,*) ncol
      WRITE(6,*) ncol

      WRITE(6,*) "Enter number of thermalization sweeps"
      READ(5,*) ntherm
      WRITE(6,*) ntherm

      WRITE(6,*) "Enter seed for random number generator"
      READ(5,*) seed
      WRITE(6,*) "Seed =",seed
 
C
C --- Initialize RANMAR random number generator on the host.
C
      CALL rmarin(seed)

C
C --- Initialize and thermalize the mesh.
C
      CALL init(ntherm)

      CALL send_seed(seed,ncol)

C     added for tallying up colors and times
      DO iter=1,3
         totalcols(iter) = 0
         totaltime(iter) = 0
      END DO

      DO iter=1,ntimes 

         CALL make_mesh
         CALL send_mesh
         CALL get_results
         
CC    wait for the nodes to acknowledge completion
C     print *,"Waiting for Acknowledgement of completion"
         DO i=0,(nprocs-1)
            status=KXREAD(type,4,i,999)
         END DO
C     print *,"Host Passed Acknowledgement"
         IF (iter.EQ.ntimes) seed = 0  ! completion flag
         CALL send_seed(seed,ncol)

      ENDDO

C
C --- Close the file
C
      close(50)
 
C
C-- Close down the nodes.
C      

C  write out results of tallies
      DO iter=1,3
         write(6, *) 'Algorithm ', iter, ' Average colors*100 = ',
     &    totalcols(iter)*100/(ntimes*ncol), ' Average time = ',
     &    totaltime(iter)/(ntimes*ncol)
      ENDDO

      WRITE(6,*) 'Finished'
      CALL KXCLOS(PGIND)
 
      END
      
C________________________________________________________

      SUBROUTINE send_seed(seed,ncol)
      include 'irreg.h'
      INTEGER seed, ncol

         IF (iswap .ne. 0) THEN
            Call kxswap(seed,seed,4,1)
            Call kxswap(ncol,ncol,4,1)
	 ENDIF
         status=kxbrod(seed,ihost,4,IALNOD,DUMMY,150)
         status=kxbrod(ncol,ihost,4,IALNOD,DUMMY,160)
         IF (iswap .ne. 0) THEN
            Call kxswap(seed,seed,4,1)
            Call kxswap(ncol,ncol,4,1)
	 ENDIF
      return
      end
      
C________________________________________________________

      subroutine get_results

      include 'irreg.h'
      integer algorithm,maxd,numcolors,numpasses,elaptime,flag
 49   format(7(1x,i10))

      flag=0
      do while (flag .eq. 0)
         status=kxread(algorithm,4,0,111)
         if (iswap .ne. 0)
     $        Call kxswap(algorithm,
     $        algorithm,4,1)
         
         if (algorithm .gt. 0) then
            status=kxread(maxd,4,0,112)
            if (iswap .ne. 0)
     $           Call kxswap(maxd,
     $           maxd,4,1)
            status=kxread(numcolors,4,0,113)
            if (iswap .ne. 0)
     $           Call kxswap(numcolors,
     $           numcolors,4,1)
            status=kxread(numpasses,4,0,114)
            if (iswap .ne. 0)
     $           Call kxswap(numpasses,
     $           numpasses,4,1)
            status=kxread(elaptime,4,0,115)
            if (iswap .ne. 0)
     $           Call kxswap(elaptime,
     $           elaptime,4,1)
            status=kxwrit(dummy,4,0,321)
            write(unit=50,fmt=49) algorithm,n,nprocs,maxd,numcolors,
     $           numpasses,elaptime
            totalcols(algorithm) = totalcols(algorithm) + numcolors
            totaltime(algorithm) = totaltime(algorithm) + elaptime
         else
            flag=1
         endif
      enddo
      
      return
      end

C________________________________________________________

      subroutine set_up_files
      integer i(1:7)

      open(unit=49,file='auto.results',form='formatted',
     $     access='sequential',status='old',err=900)
      open(unit=50,file='auto.results~',form='formatted',
     $     access='sequential')
            
C  algorithm  #vertices  #procs  max_degree  #colors  #passes  microsecs
      
 700  read(unit=49,err=799,fmt=702) i(1),i(2),i(3),i(4),i(5),i(6),i(7)
      write(unit=50,fmt=702) i(1),i(2),i(3),i(4),i(5),i(6),i(7)
 702  format(7(1x,i10))
      goto 700
 799  continue
      close(49)
      close(50)

      open(unit=50,file='auto.results',form='formatted',
     $     access='sequential')
      open(unit=49,file='auto.results~',form='formatted',
     $     access='sequential',status='old')
      
 800  read(unit=49,err=899,fmt=702) i(1),i(2),i(3),i(4),i(5),i(6),i(7)
      write(unit=50,fmt=702) i(1),i(2),i(3),i(4),i(5),i(6),i(7)
      goto 800
 899  continue
      close(49)

      goto 1000

 900  continue

      open(unit=50,file='auto.results',form='formatted',
     $     access='sequential')

 1000 continue

      return
      end
