# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
module patch_mod
  use sep3d_struct_mod
  use sep
  implicit none
  integer, parameter, public :: idbl=selected_int_kind(12)
  integer, pointer, private, save :: n(:,:),f(:,:)
  integer :: ipatch
  integer, external :: sreed,srite,sreed_window
  contains
  logical function init_patch_loop(in,wind,npatch)
    type(sep3d) :: in,wind
    integer :: maxsize,npatch
    integer(kind=idbl) :: isize
    init_patch_loop=.false.
    call from_param("maxsize",maxsize,1000)
    isize=product(in%n)
    maxsize=maxsize*1024*1024/8
    call init_sep3d(in,wind,"SCRATCH")
    if (isize > maxsize) then
      write(0,*) "patching not implemented need MB: ",isize/1024/1024
      return
    end if
    allocate(n(5,1),f(5,1))
    f=0
    n(:,1)=in%n
    ipatch=0
    npatch=size(n,2)
    init_patch_loop=.true.
  end function
  logical function done_set_patch(myn,wind)
    type(sep3d) :: wind
    integer :: myn(:)
    ipatch=ipatch+1
    done_set_patch=.false.
    if (ipatch > size(n,2)) then
      done_set_patch=.true.
      return
    end if
    myn=n(:,ipatch)
    wind%n=n(:,ipatch)
    wind%o=wind%o+wind%d*f(:,ipatch)
    call sep_mpi_stop()
    call sep3d_set_sep3d(wind)
  end function
  logical function read_patch(intag,in,buf)
    type(sep3d) :: in
    character(len=*) :: intag
    real, allocatable :: temp(:,:,:)
    complex :: buf(:,:,:,:,:)
    integer :: i5,i4,nh
    integer, external :: sep_thread_num
    allocate(temp(n(1,ipatch),n(2,ipatch),n(3,ipatch)))
    read_patch=.false.
    i4=sreed(intag,temp,4)
    do i5=1,n(5,ipatch)
      do i4=1,n(4,ipatch)
        call sep3d_grab_headers(intag,in,nh, nwind=(/n(2,ipatch),n(3&
          &,ipatch),1,1/),fwind=(/f(2,ipatch),f(3,ipatch),f(4,ipatch&
          &)+i4-1,f(5,ipatch)+i5-1/))
        if (.not. sep3d_read_data(intag,in,temp)) then
          write(0,*) "trouble reading patch"
          return
        end if
        buf(:,:,:,i4,i5)=cmplx(temp,0.)
      end do
    end do
!
! write(0,*) "CHECKaREAD RESULT",i4,i5,sep_thread_num(),sum(buf),size(temp),product(n(:3,ipatch))
    read_patch=.true.
    deallocate(temp)
!if(sep_thread_num()==0) call srite("bbb.H",buf,size(buf)*8)
! write(0,*) "CHECK2READ RESULT",i4,i5,sep_thread_num(),sum(buf)
  end function
  logical function read_temp_patch(tag,buf)
    character(len=*) :: tag
    complex :: buf(:,:,:,:,:)
    integer :: ierr
    read_temp_patch=.false.
    call sseek(tag,0,0)
    if (size(buf)*8.ne. sreed(tag,buf,size(buf)*8)) then
      write(0,*) "trouble reading temp patch"
      return
    end if
    read_temp_patch=.true.
  end function
  logical function store_temp_patch(tag,buf)
    character(len=*) :: tag
    complex :: buf(:,:,:,:,:)
    integer :: ierr
    store_temp_patch=.false.
    ierr= srite(tag,buf,4)
    call sseek(tag,0,0)
    if (size(buf)*8.ne. srite(tag,buf,size(buf)*8)) then
      write(0,*) "trouble storing temp patch"
      return
    end if
    store_temp_patch=.true.
  end function
  logical function write_patch(igam,outtag,out,semb,gathertag,gather,buf&
    &,write_gathers)
    integer :: igam
    character(len=*) :: outtag,gathertag
    type(sep3d) :: out,gather
    real :: semb(:,:,:)
    complex :: buf(:,:,:,:,:)
    real, allocatable :: rbuf(:,:,:)
    integer :: i4,i5
    logical :: write_gathers
    write_patch=.false.
    if (.not. sep3d_write_data(outtag,out,semb,nwind=(/out%n(1),out%n(2&
      &),out%n(3),1/),fwind=(/f(1,ipatch),f(2,ipatch),f(3,ipatch),igam&
      &-1/))) then
      write(0,*) "trouble writing patch semb"
      return
    end if
    if (write_gathers) then
      allocate(rbuf(n(1,ipatch),n(2,ipatch),n(3,ipatch)))
      do i5=1,n(5,ipatch)
        do i4=1,n(4,ipatch)
          rbuf=real(buf(:,:,:,i4,i5))
          if (.not. sep3d_write_data(gathertag,gather,rbuf,nwind=(&
            &/gather%n(1),gather%n(2),gather%n(3),1,1,1/),fwind=(/f(1&
            &,ipatch),f(2,ipatch),f(3,ipatch),f(4,ipatch)-1+i4,f(5,ipatch)-1+i5,igam-1/))) then
            write(0,*) "trouble writing gathers"
            return
          end if
        end do
      end do
      deallocate(rbuf)
    end if
    write_patch=.true.
  end function
end module
