# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!$=head1 NAME
!$
!$patch - extract and putback patches
!$
!$=head1 SYNOPSIS
!$
!$C<call patch_init(npatch,nwall,nwind)>
!$
!$C<ierr=ptch_lop(adj,add,wall,wind)>
!$
!$=head1 PARAMETERS
!$
!$=over 4
!$
!$=item npatches - C<integer(:)>
!$
!$ number of patches
!$
!$=item nwall - C<integer(:)>
!$
!$=item nwind - C<integer(:)>
!$
!$=item adj,add,wall,wind -
!$
!$ Standard operator interface
!$
!$=back
!$
!$=head1 DESCRIPTION
!$
!$Extract and put back patches
!$
!$=head1 SEE ALSO
!$
!$L<misinput>
!$
!$=head1 LIBRARY
!$
!$B<geef90>
!$
!$=cut
module patch_bob
! N-dimensional patch extract and putback
  use cartesian
  use adj_mod
  implicit none
  integer, private :: ipatch
  ! count till product(npatch)
  integer, dimension (:), pointer,private :: npatch, nwind, nwall
! overlap where npatch * nwind > nwall
  contains
  subroutine patch_bob_init( npatch_in, nwall_in, nwind_in)
    integer, pointer :: npatch_in(:),nwind_in(:),nwall_in(:)
    npatch=>npatch_in
    nwall=>nwall_in
    nwind=>nwind_in
    ipatch = 1
  end subroutine
  subroutine patch_index_extract(index)
    integer :: index(:)
    integer, dimension(:),allocatable :: ii, jj
    ! Ndim=size(npatch)
    integer :: i, j, shift
    allocate(ii(size(npatch)),jj(size(npatch)))
    call line2cart( npatch, ipatch, jj )
    ! (j1,j2) = (1,1) to (npatch1,npatch2)
! round jj to shift end of last patch flush against the far wall.
    where( npatch.eq.1)
      jj = 1
    elsewhere
      jj = 1.5 +( nwall - nwind)*( jj - 1.)/( npatch - 1.)
    end where
    call cart2line( nwall, jj, shift)
    ! jj is where the patch begins.
    shift = shift - 1 !
    do i = 1, size( index)
! sweep through a window
      call line2cart( nwind, i, ii)
      ! ii(i) is (i1,i2) in window
      call cart2line( nwall, ii, j)
      ! j(ii) linear subscript in window
      index( i) = j + shift
    end do
    deallocate(ii,jj)
  end subroutine
  integer function patch_bob_lop (adj,add, wall, wind)
    logical :: adj,add
    real :: wall(:),wind(:)
    integer, dimension(:),allocatable :: ii, jj
    ! Ndim=size(npatch)
    integer :: i, j, shift
    call adjnull(adj,add,wall,wind)
    allocate(ii(size(npatch)),jj(size(npatch)))
    call line2cart( npatch, ipatch, jj )
    ! (j1,j2) = (1,1) to (npatch1,npatch2)
! round jj to shift end of last patch flush against the far wall.
    where( npatch.eq.1)
      jj = 1
    elsewhere
      jj = 1.5 +( nwall - nwind)*( jj - 1.)/( npatch - 1.)
    end where
    call cart2line( nwall, jj, shift)
    ! jj is where the patch begins.
    shift = shift - 1 !
    do i = 1, size( wind)
! sweep through a window
      call line2cart( nwind, i, ii)
      ! ii(i) is (i1,i2) in window
      call cart2line( nwall, ii, j)
      ! j(ii) linear subscript in window
      if ( adj) then
        wall( j + shift) = wall( j + shift) + wind( i)
      else
        wind( i) = wind( i) + wall( j + shift)
      end if
!if(adj)
! call srite("t1.H",wind,size(wind)*4)
! else
! call srite("t2.H",wind,size(wind)*4)
    end do
    deallocate(ii,jj)
    patch_bob_lop=0
  end function
  subroutine patch_bob_close()
    ipatch = ipatch + 1
  end subroutine
end module
