program main

#define MB *1024*1024
#define MAXPE 64*1024
#define MAXCHARLEN 256
#define sion_int64 integer*8

!Enable or disable the checksum
!#define CHECKSUM

!*****************************************************************************80
!
!! The main program that will execute the necessary tests
!
	implicit none
!
	include 'mpif.h'


	integer ierr, np, rank, rankl, tmpint
	integer fsblksize
	integer*8 totalsize,bufsize, chunksize
	character, dimension(:),pointer :: localbuffer
	character(len=MAXCHARLEN) :: filename = 'test_sionfile.dat'
	character(len=MAXCHARLEN) :: newfname = 'newfile'

	integer   :: verbose, debug, debug1,bluegene, bluegene_np, narg, nfiles
	character(len=64) argv

	logical	collectiveread

	double precision gstarttime,starttime,opentime,gwritetime,writetime,closetime,readtime,greadtime
  	double precision barr1time,barr2time,barr3time

  	integer*8 bsumwrote,sumsize,bsumread, left

  	real*8  checksum_fp, checksum_read_fp
  	integer globalrank, sid, i, e

  	integer*8 bwrite,bwrote,btoread,bread
  	integer feof

	integer   chunkcnt,size1
	integer*8 rchunksize
	integer   rblocksize
	character(len=MAXCHARLEN) cbuffer

	integer comm,gComm,lComm

	call MPI_INIT(ierr)
	call MPI_COMM_SIZE(MPI_COMM_WORLD, np, ierr)
	call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)

	bufsize   = 10 MB
	totalsize = 20 MB
	chunksize = bufsize
	fsblksize = 2 MB	! IBM GPFS
	nfiles = 1

	collectiveread = .TRUE.

	if(rank == 0) then
!       parse command line
	    i=1
        narg = COMMAND_ARGUMENT_COUNT()
	    do while( i < narg )
	      call GET_COMMAND_ARGUMENT(i, argv)

	      if( argv(:1) == '-' ) then

			select case( argv(2:) )
				case ('f')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  filename = trim(argv)
				case ('F')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)

				case ('b')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') bufsize
				case ('B')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') bufsize
				  bufsize = bufsize MB
				case ('s')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') totalsize
				case ('n')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') nfiles
				case ('S')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') totalsize
				  totalsize = totalsize MB
				case ('r')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') chunksize
				case ('R')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') chunksize
				  chunksize = chunksize MB
				case ('q')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') fsblksize
				case ('Q')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  read(argv,'(I20)') fsblksize
				  fsblksize = fsblksize MB
				case ('T')
				  i = i+1
				  call GET_COMMAND_ARGUMENT(i, argv)
				  if (argv /= '0') then
				   	collectiveread = .TRUE.
				  else
				   	collectiveread = .FALSE.
				  end if
				case default
				  call GET_COMMAND_ARGUMENT(0, argv)
				  call usage(argv)
				  call exit(1)
			end select
		  else
		  	call GET_COMMAND_ARGUMENT(0, argv)
			call usage(argv)
			call exit(1)
		  end if
		  i = i+1
		end do
  	end if

	call MPI_Bcast(filename,MAXCHARLEN,MPI_CHARACTER,0,MPI_COMM_WORLD, ierr)
	call MPI_Bcast(bufsize,1,MPI_INTEGER8,0,MPI_COMM_WORLD, ierr)
	call MPI_Bcast(totalsize,1,MPI_INTEGER8,0,MPI_COMM_WORLD, ierr)
	call MPI_Bcast(chunksize,1,MPI_INTEGER8,0,MPI_COMM_WORLD, ierr)
	call MPI_Bcast(fsblksize,1,MPI_INTEGER,0,MPI_COMM_WORLD, ierr)
	call MPI_Bcast(collectiveread,1,MPI_LOGICAL,0,MPI_COMM_WORLD, ierr)
	call MPI_Bcast(nfiles,1,MPI_INTEGER,0,MPI_COMM_WORLD, ierr)


    if (rank == 0) then
#ifndef	CHECKSUM
    write(0, '(A)') "partest parameter:                 Checksum DISABLED!!"," "
#endif
	write(0, 100) "datafile", trim(filename)
	write(0, 103) "number of files",nfiles

	write(0, 101) "local buffer size / task", bufsize, bufsize/(1.0 MB)
	write(0, 101) "total data size / task", totalsize, totalsize/(1.0 MB)
	write(0, 101) "sion chunk size", chunksize, chunksize/(1.0 MB)
	write(0, 101) "fs block size", fsblksize, fsblksize/(1.0 MB)
	write(0, 102) "Collective", collectiveread


100	format("partest parameter:	",A30,TR1,"		= ",A)
101	format("partest parameter:	",A30,TR1,"		= ",I10," bytes (",F10.4," MB)")
102	format("partest parameter:	",A30,TR1,"		= ",L5)
103	format("partest parameter:	",A30,TR1,"		= ",I10)

    end if

    call barrier_after_start(MPI_COMM_WORLD)

    allocate( localbuffer(bufsize) )
    localbuffer(:) = achar(ichar('a')+rank)

    call barrier_after_malloc(MPI_COMM_WORLD)

    size1 = np
    comm = MPI_COMM_WORLD
!    lcomm = MPI_COMM_WORLD
    gComm = comm
    globalrank = rank

!  ****************************** WRITE *****************************
! TODO: REMOVE TRIM
    starttime = MPI_Wtime()
    call fsion_paropen_mpi(trim(filename),'bw',nfiles, gComm,lComm,chunksize,fsblksize,globalrank,newfname,sid)
    
    opentime = MPI_Wtime() - starttime
    
    call MPI_COMM_RANK(lComm, rankl, ierr)

    starttime = MPI_Wtime()
    call barrier_after_open(lComm)
    barr1time = MPI_Wtime()-starttime

    checksum_fp = 0
    left = totalsize
    bsumwrote = 0
    chunkcnt = 0

    starttime = MPI_Wtime()
    gstarttime = starttime
    ! Fortran 90 specific!
	do while(left > 0)
		bwrite = bufsize
		if (bwrite > left) bwrite = left

		call fsion_ensure_free_space(sid,bwrite,ierr)
		call fsion_write(localbuffer, 1, bwrite, sid, bwrote)

#ifdef CHECKSUM
		do i=1,bwrote
			checksum_fp = checksum_fp + real(IACHAR(localbuffer(i)))
		end do
#endif

		left = left - bwrote
    	bsumwrote = bsumwrote + bwrote
    	chunkcnt = chunkcnt + 1

!		if (rank == 0) write(0, *) 'Chunk ',chunkcnt,': Wrote ', bwrote,'bytes data! Left: ',left
	end do

	writetime = MPI_Wtime() - starttime

  	starttime = MPI_Wtime()
	call barrier_after_write(lComm)
	barr2time = MPI_Wtime() - starttime
	gwritetime = MPI_Wtime() - gstarttime

	starttime = MPI_Wtime()
	call fsion_parclose_mpi(sid,ierr)
 	closetime = MPI_Wtime() - starttime

  	starttime = MPI_Wtime()
	call barrier_after_close(lComm)
	barr3time = MPI_Wtime()-starttime

	if (writetime == 0) writetime = -1

!  	if(verbose) {
!    sprintf(cbuffer,"timings[%03d] open=%10.6fs write=%10.6fs close=%10.6fs
! barrier(open=%10.6fs, write=%10.6fs, close=%10.6fs) #chunks=%d bw=%10.4f MB/s ionode=%d\n",
!	    rank1,opentime,writetime,closetime,
!	    barr1time,barr2time,barr3time,chunkcnt,
!	    totalsize/1024.0/1024.0/writetime,rank3);
!    collective_print_gather(cbuffer,comm1);
!  }

  	if (nfiles > 1) then
    	call MPI_REDUCE(bsumwrote, sumsize, 1, MPI_INTEGER8, MPI_SUM, 0, lComm, ierr)
    	if(rankl == 0) then
    		write (0,111) 1.0*sumsize/1024.0/1024.0, newfname
111     	format("Write partest result: wrote ",F10.4," MB to >",A30,"<")
    	end if
    end if

	call MPI_REDUCE(bsumwrote, sumsize, 1, MPI_INTEGER8, MPI_SUM, 0, gComm, ierr)
	call MPI_BARRIER(gComm,ierr)

	if (rank == 0) then
		write(0,'(A)') "-----------------------------------------------------------------------"
    	write(0,112) 1.0*sumsize/1024.0/1024.0, gwritetime, 1.0*sumsize/1024.0/1024.0/gwritetime

112     format("TOTAL: Write partest result: wrote ",F10.4," MB write+barrier= ",F10.6,"s bw= ",F10.4," MB/s")
		write(0,'(A)') "-----------------------------------------------------------------------"
    end if

  	if (nfiles > 1) then
  	  call MPI_BARRIER(lComm,ierr)
      call MPI_COMM_FREE(lComm,ierr)
    end if

    if (rank == 0) write(0,'(A)') "***********************************************************************"

!  ****************************** READ *****************************
	localbuffer(:) = ' '

	starttime = MPI_Wtime();
  	if (collectiveread) then 
             call fsion_paropen_mpi(trim(filename),'br',nfiles, gComm,lComm,chunksize,fsblksize,globalrank,newfname,sid)
	else
             call fsion_open_rank(trim(filename),"br",rchunksize,rblocksize,rank,sid)
  	end if

  	opentime = MPI_Wtime()-starttime

	call MPI_COMM_RANK(lComm, rankl, ierr)

	starttime = MPI_Wtime()
  	call barrier_after_open(lComm)
	barr1time = MPI_Wtime()-starttime

	starttime = MPI_Wtime()
	gstarttime = starttime

	checksum_read_fp = 0
	left = totalsize
	bsumread = 0
	chunkcnt = 0

    call fsion_feof(sid,feof)

	do while( (left > 0) .AND. (feof /= 1 ) )
	    btoread=bufsize

    	if( btoread>left ) btoread = left

    	call fsion_read(localbuffer, 1, btoread, sid, bread)

#ifdef	CHECKSUM
		do i=1,bread
			checksum_read_fp = checksum_read_fp + real(IACHAR(localbuffer(i)))
		end do
#endif

		left = left - bread
    	bsumread = bsumread + bread
    	chunkcnt = chunkcnt + 1
!		if (rank == 0) write(0, *) 'Chunk ',chunkcnt,': Read ', bread,'bytes data! Left: ',left

    	call fsion_feof(sid,feof)
	end do

	readtime = MPI_Wtime()-starttime

	starttime = MPI_Wtime()
 	call barrier_after_read(lComm)
	barr2time = MPI_Wtime()-starttime

 	greadtime = MPI_Wtime()-gstarttime

	starttime = MPI_Wtime()
	if(collectiveread) then
    	call fsion_parclose_mpi(sid,ierr)
  	else
    	call fsion_close(sid,ierr)
  	end if
  	closetime = MPI_Wtime()-starttime

   	if(readtime == 0) readtime = -1

#ifdef  CHECKSUM
	if (abs(checksum_fp-checksum_read_fp)>1e-5) then
		    write(0,*)"ERROR in double checksum  ",checksum_fp,"!=",checksum_read_fp," diff=",(checksum_fp-checksum_read_fp)
    end if
#endif

  	if (nfiles > 1) then
    	call MPI_REDUCE(bsumread, sumsize, 1, MPI_INTEGER8, MPI_SUM, 0, lComm, ierr)
    	if(rankl == 0) then
    		write (0,113) 1.0*sumsize/1024.0/1024.0, newfname
113     	format("Read partest result: read ",F10.4," MB from >",A30,"<")
    	end if
    end if



   	call MPI_REDUCE(bsumread, sumsize, 1, MPI_INTEGER8, MPI_SUM, 0, gComm, ierr)
	call MPI_BARRIER(gComm,ierr)

	if (rank == 0) then
		write(0,'(A)') "-----------------------------------------------------------------------"
    	write(0,114) 1.0*sumsize/1024.0/1024.0, greadtime, 1.0*sumsize/1024.0/1024.0/greadtime

114     format("TOTAL: Read partest result: read ",F10.4," MB read+barrier= ",F10.6,"s bw= ",F10.4," MB/s")
		write(0,'(A)') "-----------------------------------------------------------------------"
    end if

  	if (nfiles > 1) then
  	  call MPI_BARRIER(lComm,ierr)
      call MPI_COMM_FREE(lComm,ierr)
    end if
!  ****************************** END *****************************
	deallocate(localbuffer)

	call MPI_Finalize(ierr)
	stop
end

subroutine barrier_after_start(comm)
  integer, intent(in) :: comm
  integer ierr
  call MPI_BARRIER(comm,ierr)
end

subroutine barrier_after_malloc(comm)
  integer, intent(in) :: comm
  integer ierr

  call MPI_BARRIER(comm,ierr)
end

subroutine barrier_after_open(comm)
	integer, intent(in) :: comm
	integer ierr
	call MPI_BARRIER(comm,ierr)
return
end

subroutine barrier_after_write(comm)
	integer, intent(in) :: comm
	integer	ierr
	call MPI_BARRIER(comm,ierr)
end

subroutine barrier_after_read(comm)
	integer, intent(in) :: comm
	integer	ierr
	call MPI_BARRIER(comm,ierr)
end

subroutine barrier_after_close(comm)
	integer, intent(in) :: comm
	integer	ierr
	call MPI_BARRIER(comm,ierr)
end

subroutine collective_print_gather ( cbuffer, comm)
	character, dimension(:), intent(in) :: cbuffer
	integer, intent(in) :: comm

	integer rank, np, p, ierr
	character, dimension(:), allocatable :: lbuffer

	! Allocate the memory for this array
	allocate( lbuffer(MAXCHARLEN*MAXPE) )

	call MPI_COMM_SIZE(comm, np, ierr)
	call MPI_COMM_RANK(comm, rank, ierr)

	call MPI_GATHER(cbuffer, MAXCHARLEN, MPI_CHARACTER, lbuffer, MAXCHARLEN, MPI_CHARACTER, 0, comm, ierr)

	if(rank .EQ. 0) then
		do p = 0, np
			write(0,*) lbuffer( (p*MAXCHARLEN+1):((p+1)*MAXCHARLEN) )
		end do
	end if

  	! Free the memory of this array
  	deallocate(lbuffer)
end

subroutine usage(name)
	character(len=64), intent(in) :: name

	write(0, '(A,A,A,/,A)') "Usage: ",TRIM(name)," <options>","with the following optional options (default values in parathesis)"
	write(0, '(/,A)') " Sion File Settings:"
    write(0, *) "  [-f filename]          filename of direct access file"
    write(0, *) "  [-r <chunksize>]       sion chunk size in bytes"
    write(0, *) "  [-R <chunksize>]       sion chunk size in MBytes"
    write(0, *) "  [-q <fsblksize>]       size of filesystem blocks in bytes"
    write(0, *) "  [-Q <fsblksize>]       size of filesystem blocks in MBytes"

    write(0, *) "  [-b <bufsize>]         size of blocks written in ONE fwrite in bytes"
    write(0, *) "  [-B <bufsize>]         size of blocks written in ONE fwrite in MBytes"
    write(0, *) "  [-s <totalsize>]       total size of data written by each processor in bytes"
    write(0, *) "  [-S <totalsize>]       total size of data written by each processor in MBytes"
    write(0, *) "  [-T <type>]            type of test (0): w/o collective read "

end

