#if HAVE_CONFIG_H
#   include "config.fh"
#endif
c
c FNAME - filename for test program
c
#define BASE_NAME  '/scratch/da.try'
#define BASE_NAME1 '/scratch/da1.try'
#ifdef  HPIODIR
#  define FNAME   HPIODIR//BASE_NAME
#  define FNAME1  HPIODIR//BASE_NAME1
#else
#  define FNAME   BASE_NAME
#  define FNAME1  BASE_NAME1
#endif

c#define MULTFILES 1

#ifdef SOLARIS
#  if MULTFILES
#    define USEMULTFILES 1
#  endif
#else
#  define USEMULTFILES 1
#endif

      program io
#include "mafdecls.fh"
#include "global.fh"
#include "dra.fh"
      integer status, me
      integer max_arrays
      integer stack, heap
      double precision max_sz, max_disk, max_mem 
      data max_arrays, max_sz, max_disk, max_mem /10,1d8,1d10, 1d6/
#if   defined(IBM)|| defined(CRAY_T3E)
      data stack, heap /70000000, 4000000/
#else
      data stack, heap /1200000, 800000/
#endif
c
#include "mp3.fh"
      call ga_initialize()
      if(.not. ga_uses_ma())then
         stack = 100000 
         heap  = 100000 
      endif
c
      if(ma_init(MT_F_DBL, stack, heap) ) then
        me    = ga_nodeid()
        if(dra_init(max_arrays, max_sz, max_disk, max_mem).ne.0)then
                call ga_error('dra_init failed: ',0)
        endif
        if (me.eq.0) print *,'  '
        if(me.eq.0)print *, 'TESTING PERFORMANCE OF DISK ARRAYS'
        if (me.eq.0) print *,' '
        call test_io_dbl()
        status = dra_terminate()
        call ga_terminate()
      else
        print *,'ma_init failed'
      endif
      if(me.eq.0)print *, 'all done ...'
      call MP_FINALIZE()
      end



      subroutine test_io_dbl
      implicit none
#include "mafdecls.fh"
#include "global.fh"
#include "dra.fh"
#include "mp3def.fh"
      integer n,m,ndim
      parameter (n=250, ndim=3)
      parameter (m = 2*n)
      double precision   err, tt0, tt1, mbytes, rmax, ravg
      integer g_a, g_b,  d_a, d_b
      double precision drand
      integer i, req, loop
      integer dlo(ndim),dhi(ndim),glo(ndim),ghi(ndim)
      integer dims(ndim),reqdims(ndim)
      integer me, nproc
      integer index, ld(ndim), chunk(ndim)
      integer iran
#if USEMULTFILES
      integer ilen
      character*80 filename, filename1
#endif
      integer util_mdtob
      logical status
      external  drand
      external util_mdtob
      intrinsic int, dble
      iran(i) = int(drand(0)*dble(i-1)) + 1
c    
      loop  = 30
      req = -1
      nproc = ga_nnodes()
      me    = ga_nodeid()
c    
      if (me.eq.0) print *, 'Creating global arrays ',n,' x',n,' x',n
      if (me.eq.0)call ffflush(6)
      call ga_sync()
      do i = 1, ndim
        dims(i) = n
        chunk(i) = 1
      end do

      if(.not. nga_create(MT_DBL, ndim, dims, 'a', chunk, g_a))
     &         call ga_error('nga_create failed: a', 0)
      if(.not. nga_create(MT_DBL, ndim, dims, 'b', chunk, g_b))
     &         call ga_error('nga_create failed: b', 0)
      if (me.eq.0) print *,'done '
      if (me.eq.0)call ffflush(6)
c
c     initialize g_a, g_b with random values
c     ... use ga_access to avoid allocating local buffers for ga_put
c
      call ga_sync()
      call nga_distribution(g_a, me, glo, ghi)
      call nga_access(g_a, glo, ghi, index, ld)
      call fill_random(DBL_MB(index), glo, ghi, ld(1), ld(2))
      call ga_sync()
*     if (me.eq.0) print *,'done '
*     if (me.eq.0)call ffflush(6)
c
      call ga_zero(g_b)
c
c
c.......................................................................
      if (me.eq.0) print *, 'creating disk array ',n,' x',n,' x',n
      if (me.eq.0)call ffflush(6)
      do i = 1, ndim
        reqdims(i) = n
      end do
#if USEMULTFILES
      ilen = len(FNAME)
      filename(1:ilen) = FNAME
      write(filename(ilen+1:ilen+1),200) me
  200 format(i1)
      if(ndra_create(MT_DBL, ndim, dims, 'A',
     &      filename, 
     &      DRA_RW, reqdims, d_a).ne.0)
     $   CALL ga_error('ndra_create failed: ',0)
#else
      if(ndra_create(MT_DBL, ndim, dims, 'A',
     &      FNAME, 
     &      DRA_RW, reqdims, d_a).ne.0)
     $   CALL ga_error('ndra_create failed: ',0)
#endif
c
      if(me.eq.0) print *, 'alligned blocking write'
      if (me.eq.0)call ffflush(6)
      tt0 = MP_TIMER()
      if(ndra_write(g_a, d_a,req).ne.0)
     $   CALL ga_error('ndra_write failed:',0)
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
      tt1 = MP_TIMER() -tt0
      rmax = tt1
      call ga_dgop(1,rmax,1,'max')
      mbytes = 1e-6*util_mdtob(n*n*n)
      if (me.eq.0)then
          write(6,100)mbytes,rmax,mbytes/rmax
      endif
c
      if(dra_close(d_a).ne.0)call ga_error('dra_close failed: ',d_a)
      tt1 = MP_TIMER() -tt0
      rmax = tt1
      call ga_dgop(1,rmax,1,'max')
      if (me.eq.0)then
          write(6,100)mbytes,rmax,mbytes/rmax
      endif
c
      if (me.eq.0) print *,' '
      if (me.eq.0) print *,'disk array closed '
      if (me.eq.0)call ffflush(6)
c.......................................................................
c
c
      if (me.eq.0) print *, 'creating disk array ',m,' x',m,' x',m
      if (me.eq.0)call ffflush(6)
      do i = 1, ndim
        dims(i) = m
        reqdims(i) = n
      end do
#ifdef USEMULTFILES
      ilen = len(FNAME1)
      filename1(1:ilen) = FNAME1
      write(filename1(ilen+1:ilen+1),200) me
      if(ndra_create(MT_DBL, ndim, dims, 'B',
     &      filename1,
     &      DRA_RW, reqdims, d_b).ne.0)
     $   CALL ga_error('ndra_create failed: ',0)
#else
      if(ndra_create(MT_DBL, ndim, dims, 'B',
     &      FNAME1,
     &      DRA_RW, reqdims, d_b).ne.0)
     $   CALL ga_error('ndra_create failed: ',0)
#endif
c
      if(me.eq.0) print *, 'non alligned blocking write'
      if (me.eq.0)call ffflush(6)
c
      do i = 1, ndim
        glo(i) = 1
        ghi(i) = n
        dlo(i) = 2
        dhi(i) = n+1
      end do
      tt0 = MP_TIMER()
      if(ndra_write_section(.false., g_a, glo, ghi,
     &               d_b, dlo, dhi, req).ne.0)
     &         call  ga_error('ndra_write_section failed:',0)

      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
      tt1 = MP_TIMER() -tt0
      rmax = tt1
      call ga_dgop(1,rmax,1,'max')
      mbytes = 1e-6*util_mdtob(n*n*n)
      if (me.eq.0)then
          write(6,100)mbytes,rmax,mbytes/rmax
      endif
c
      if(dra_close(d_b).ne.0)call ga_error('dra_close failed: ',d_b)
      tt1 = MP_TIMER() -tt0
      rmax = tt1
      call ga_dgop(1,rmax,1,'max')
      mbytes = 1e-6*util_mdtob(n*n*n)
      if (me.eq.0)then
          write(6,100)mbytes,rmax,mbytes/rmax
      endif
c
      if (me.eq.0) print *,' '
      if (me.eq.0) print *,'disk array closed '
      if (me.eq.0)call ffflush(6)
c.......................................................................
c
c
      if (me.eq.0) print *,' '
      if (me.eq.0) print *,'opening disk array'
#ifdef USEMULTFILES
      if(dra_open(filename,
     &            DRA_R, d_a).ne.0)
     &            call ga_error('dra_open failed',0)
#else
      if(dra_open(FNAME,
     &            DRA_R, d_a).ne.0)
     &            call ga_error('dra_open failed',0)
#endif
      if(me.eq.0) print *, 'alligned blocking read'
      if (me.eq.0)call ffflush(6)
      tt0 = MP_TIMER()
      if(ndra_read(g_b, d_a, req).ne.0)
     $   CALL ga_error('ndra_read failed:',0)
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
      tt1 = MP_TIMER() -tt0
      rmax = tt1
      call ga_dgop(1,rmax,1,'max')
      if (me.eq.0)then
          write(6,100)mbytes,rmax,mbytes/rmax
      endif
      call ga_dadd(1d0, g_a, -1d0, g_b, g_b)
      err = ga_ddot(g_b, g_b)
      if(err.ne.0) then
          if (me.eq.0) print *,'BTW, we have error =', err
cbjp          call ga_print(g_b) 
      else
          if (me.eq.0) print *,'OK'
      endif
      if(dra_delete(d_a).ne.0)
     &            call ga_error('dra_delete failed',0)
c.......................................................................
c
      if (me.eq.0) print *,' '
      if (me.eq.0) print *,'opening disk array'
#ifdef USEMULTFILES
      if(dra_open(filename1,
     &            DRA_R, d_b).ne.0)
     &            call ga_error('dra_open failed',0)
#else
      if(dra_open(FNAME1,
     &            DRA_R, d_b).ne.0)
     &            call ga_error('dra_open failed',0)
#endif
      if(me.eq.0) print *, 'non alligned blocking read'
      if (me.eq.0)call ffflush(6)
      tt0 = MP_TIMER()
      if(ndra_read_section(.false., g_b, glo, ghi,
     &               d_b, dlo, dhi, req).ne.0)
     &        call   ga_error('ndra_read_section failed:',0)
      if(dra_wait(req).ne.0) call ga_error('dra_wait failed: ' ,req)
      tt1 = MP_TIMER() -tt0
      rmax = tt1
      call ga_dgop(1,rmax,1,'max')
      if (me.eq.0)then
          write(6,100)mbytes,rmax,mbytes/rmax
      endif
      call ga_dadd(1d0, g_a, -1d0, g_b, g_b)
      err = ga_ddot(g_b, g_b)
      if(err.ne.0) then
          if (me.eq.0) print *,'BTW, we have error =', err
      else
          if (me.eq.0) print *,'OK'
      endif
      if(dra_delete(d_b).ne.0)
     &            call ga_error('dra_delete failed',0)
c.......................................................................
      status = ga_destroy(g_a)
      status = ga_destroy(g_b)
100   format(g11.2,' MB  time=',g11.2,' rate=',g11.3,'MB/s')
      end

      subroutine fill_random(a, lo, hi, ld1, ld2)
      parameter (ndim = 3)
      integer lo(ndim), hi(ndim), ld1, ld2
      double precision a(ld1,ld2,*), drand, seed1, seed2
      integer i,j,k
      external  drand
c
      do k=1, hi(3)-lo(3) + 1
        seed1 = drand(k)
        do j = 1, hi(2) - lo(2) + 1
          seed2 = seed1*j
          do i = 1, hi(1) - lo(1) + 1
            a(i,j,k)=seed2*i
          end do
        enddo
      enddo
      end
