!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE cbem_lap_solv
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!********************************  COLLOCATION BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  *********************************!
!***************************************  3-NODED TRIANGULAR ELEMENT: ANALYTIC INTEGRATION  ***************************************!
!***********************************************  PIECEWISE CONSTANT APPROXIMATION  ***********************************************!
!***************************************************  Solve the Discretized BIE  **************************************************!
!**********************************************************************************************************************************!

!*** Developer: Sylvain Nintcheu Fata, Oak Ridge National Laboratory
!*** Version:   V.1.2
!*** Released:  Apr 21, 2011


USE KINDS
USE SRF_GEOM,  ONLY: nbelt   ! nbelt == Total number of boundary elements
USE SRF_COND,  ONLY: eltbc   ! eltbc(k) = {0,1} ==> {Dirichlet,Neunamm} boundary condition is prescribed on element k
USE DISCR_BIE, ONLY: g,rhs   ! g == Discretized BIE matrix or Left-hand side of the BEM equation
                             ! rhs == Right-hand side of the Discretized BIE
USE POTFLUX,   ONLY: phi,flx ! phi == Vector containing boundary potentials
                             ! flx == Vector containing boundary fluxes
USE ITER_SOLV,ONLY: ldim       ! ldim == Dimension of the iterative solver BiCGSTAB(ldim)
USE ITER_SOLV,ONLY: mxmatvec   ! mxmatvec == Maximum number of matrix-vector mutiplications in the iterative solver BiCGSTAB(ldim)
USE ITER_SOLV,ONLY: slv_eps    ! slv_eps == Tolerance on the BiCGSTAB(ldim) iterative solver
USE PRECOND,  ONLY: sparseflg  ! sparseflg == Parameter that determines the sparsity pattern of the preconditoner
			       ! sparseflg = 0 ==> no preconditoner
			       ! sparseflg = 1 ==> the sparsity pattern of the preconditoner is given by cell self-interactions
			       ! sparseflg = 1+n ==> the sparsity pattern of the preconditoner is given by cell + n Neighbors interactions
USE CELL_ARP, ONLY: ncwelt     ! ncwelt == Number of computional Cells containing boundary elements <==> number of non-empty cells
USE CELL_ARP, ONLY: cwelt,cell ! cwelt(k) == Global index of the k-th non-empty cell
			       ! cell(k) == Structure containing information about the k-th cell
USE PRECOND, ONLY: gcsr        ! gcsr == Preconditioner <==> Sparse approximation of g in Compressed Sparse Row (CSR) format
USE PRECOND, ONLY: igcsr,jgcsr ! igcsr == Pointers in gcsr of the beginning of each row of g
                               ! jgcsr == Column indices of the entries of gcsr as stored in the Discretized BIE matrix g


IMPLICIT NONE

 logical          :: pcond_flg ! pcond_flg = .true. ==> there is a preconditioner; pcond_flg = .false. ==> there is no preconditioner
 integer(kind=k9) :: i,ii,k,kk,l,j,jj,nk,nj,info,alloc_st
 integer(kind=k9) :: nmatvec ! nmatvec == Number of matrix-vector mutiplications performed until convergence in BiCGSTAB(ldim)
 integer(kind=k9) :: nnz_gcsr ! nnz_gcsr == Number of non-zero entries in the Sparse approximation of the Discretized BIE matrix g
 real   (kind=dp) :: tol ! tol == Residual achieved at the solution
 real   (kind=dp), pointer :: solvec(:) ! solvec == Solution vector

!----------------------------------------------------------------------------------------------------------------------------------!
INTERFACE
!----------------------------------------------------------------------------------------------------------------------------------!

!----------------------------------------------------------------------------------------------------------------------------------!
  SUBROUTINE mat_vec(m,x,y)
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!******************************************  Compute the Matrix vector product: y:=A*x ********************************************!
!**********************************************************************************************************************************!

   USE KINDS

   IMPLICIT NONE
   
    integer(kind=k9), intent(in ) :: m    ! m == Dimension of vectors "x" and "y"
    real   (kind=dp), intent(in ) :: x(m)
    real   (kind=dp), intent(out) :: y(m) ! y = A*x

!----------------------------------------------------------------------------------------------------------------------------------!    
  END SUBROUTINE mat_vec
!----------------------------------------------------------------------------------------------------------------------------------!  


!----------------------------------------------------------------------------------------------------------------------------------!
  SUBROUTINE ilu0_l_pcond(m,x)
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!****************************************** Compute the Matrix vector product: y=M^{-1}*x *****************************************!
!************************************************** i.e. solve the system: M*y=x **************************************************!
!**********************************************************************************************************************************!

!---note---= M is a left preconditioner
!---note---= The solution y is written in x on ouput

   USE KINDS

   IMPLICIT NONE
   
    integer(kind=k9), intent(in)    :: m ! m == Dimension of the vector "x"
    real   (kind=dp), intent(inout) :: x(m)

!----------------------------------------------------------------------------------------------------------------------------------!    
  END SUBROUTINE ilu0_l_pcond
!----------------------------------------------------------------------------------------------------------------------------------!  

!----------------------------------------------------------------------------------------------------------------------------------!
END INTERFACE
!----------------------------------------------------------------------------------------------------------------------------------!



    allocate(solvec(nbelt),STAT=alloc_st) 
    if ( alloc_st == 0 ) then  ! If solvec is successfully allocated
       loop0: do k=1,nbelt
          solvec(k) = 0.0_dp
       enddo loop0
    else
       write(*,*)'cbem_lap_solv: Allocate array "solvec" failed with Status=',alloc_st
       stop
    endif

    nmatvec = mxmatvec; tol = slv_eps

    if ( sparseflg == 0 ) then ! sparseflg=0 ==> no sparse approximation of the Discretized BIE matrix g <==> no preconditioner
          pcond_flg = .false. ! pcond_flg = .false. <==> no preconditioner
    elseif ( sparseflg > 0 ) then ! sparseflg > 0 <==> use a preconditioner
          pcond_flg = .true. ! pcond_flg = .true. <==> use a preconditioner
	  write(*,100)'           >>>  Preconditioning <<<'    
	  write(*,100)'           >>>  cell Initialization <<<'    
          call cbem_cell_init ! Construct the computational box and distribute without repetition boundary elements into cells,
	                      ! i.e, Initialize non-empty cells in arrays cell and cwelt, define the parameter ncwelt
	  if ( sparseflg == 1 ) then  ! sparseflg=1 ==> the sparsity pattern of the preconditoner is given by cell self-interactions

 		nnz_gcsr = 0
		loop1: do k=1,ncwelt ! Loop over all non-empty cells
		   nk = cell(cwelt(k))%nec ! nk = Number of boundary elements in the k-th cell
		   nnz_gcsr = nnz_gcsr + nk*nk
 		enddo loop1
	  
!*** gcsr == Sparse approximation of the Discretized BIE matrix g
		allocate(igcsr(nnz_gcsr),jgcsr(nnz_gcsr),gcsr(nnz_gcsr),STAT=alloc_st)
		if ( alloc_st == 0 ) then  ! If igcsr,jgcsr,gcsr are successfully allocated
		      ii = 1
		      loop2a: do k=1,ncwelt ! Loop over all non-empty cells
			 kk = cwelt(k) ! kk == Global index of the k-th cell
			 nk = cell(kk)%nec ! nk == Number of boundary elements (or Representative nodes) in the k-th cell
			 loop2b: do l=1,nk ! Loop over all representative nodes in the k-th cell
			    loop2c: do i=1,nk ! Loop over all representative nodes in the k-th cell
				gcsr(ii) = g(cell(kk)%elt_id(i),cell(kk)%elt_id(l)) ! Here gcsr is stored in COOrdinate (COO) format
			       igcsr(ii) = cell(kk)%elt_id(i)  ! igcsr(ii) =    Row index in g of the ii entry of gcsr
			       jgcsr(ii) = cell(kk)%elt_id(l)  ! jgcsr(ii) = Column index in g of the ii entry of gcsr
			       ii = ii+1
			    enddo loop2c
			 enddo loop2b
 		      enddo loop2a
		else
 		      write(*,*)'cbem_lap_solv: C1: Allocate arrays "igcsr,jgcsr,gcsr" failed with Status =',alloc_st
		      stop
		endif
	  else ! sparseflg > 1
                call cbem_cell_neighbor ! For all cell, find near-neighbors
                nnz_gcsr = 0
	        loop3a: do k=1,ncwelt ! Loop over all non-empty cells
	           nk = cell(cwelt(k))%nec ! nk == Number of boundary elements (or Representative nodes) in the k-th cell
		   if ( cell(cwelt(k))%nnnc .ge. sparseflg ) then
		         cell(cwelt(k))%nnbsprs = sparseflg    
		   else ! cell(cwelt(k))%nnnc == Number of Near-neighboring cells to the k-th cell including the k-th cell itself
		        cell(cwelt(k))%nnbsprs = cell(cwelt(k))%nnnc ! cell(cwelt(k))%nnbsprs == Number of Near-Neighboring cells to
			                                             !                           the k-th cell used to define gcsr
		   endif
		   
		   loop3b: do j=1,cell(cwelt(k))%nnbsprs ! Loop over the near-neighboring cells to the k-th cell
                                         ! cell(cwelt(k))%nbor(j) == Global index of the j-th near-neighboring cell to the k-th cell
 		       nj = cell(cell(cwelt(k))%nbor(j))%nec ! nj == Number of boundary elements (or Representative nodes)
		                                             !       in the j-th cell
	               nnz_gcsr = nnz_gcsr + nk*nj ! nnz_gcsr = Number of non-zero entries in gcsr
 		   enddo loop3b
                enddo loop3a

!*** gcsr == Sparse approximation of the Discretized BIE matrix g
		allocate(igcsr(nnz_gcsr),jgcsr(nnz_gcsr),gcsr(nnz_gcsr),STAT=alloc_st)
		if ( alloc_st == 0 ) then  ! If igcsr,jgcsr,gcsr are successfully allocated
		      ii = 1
		      loop4a: do k=1,ncwelt ! Loop over all non-empty cells
			 kk = cwelt(k) ! kk == Global index of the k-th cell
			 nk = cell(kk)%nec ! nk = Number of boundary elements (or Representative nodes) in the k-th cell
			 loop4b: do j=1,cell(kk)%nnbsprs ! Loop over the near-neighboring cells to the k-th cell
                            jj = cell(kk)%nbor(j) ! jj == Global index of the j-th near-neighboring cell to the k-th cell
 		            nj = cell(jj)%nec ! nj == Number of boundary elements (or Representative nodes) in the j-th cell

			    loop4c: do l=1,nj ! Loop over all representative nodes in the j-th cell
			       loop4d: do i=1,nk ! Loop over all representative nodes in the k-th cell
				  gcsr(ii)=g(cell(kk)%elt_id(i),cell(jj)%elt_id(l)) ! Here gcsr is stored in COOrdinate (COO) format
			          igcsr(ii) = cell(kk)%elt_id(i)  ! igcsr(ii) =    Row index in g of the ii entry of gcsr
			          jgcsr(ii) = cell(jj)%elt_id(l)  ! jgcsr(ii) = Column index in g of the ii entry of gcsr
			          ii = ii+1
			       enddo loop4d
			    enddo loop4c
			 enddo loop4b
 		      enddo loop4a
		else
 		      write(*,*)'cbem_lap_solv: C2: Allocate arrays "igcsr,jgcsr,gcsr" failed with Status =',alloc_st
		      stop
		endif
	  endif ! sparseflg > 1

	call coo2csr(nbelt,nnz_gcsr,gcsr,igcsr,jgcsr) ! Convert gcsr from COO to Compressed Sparse Row (CSR) format
	write(*,100)'           >>>  Zero Fill-in Incomplete LU: ILU(0) <<<'
	call csr_ilu0(nbelt,gcsr,igcsr,jgcsr) ! Generate the left preconditioner: Zero Fill-in Incomplete LU Factorization

    else  ! sparseflg < 0
       write(*,*)'Warning: Incorrect value for sparseflg ==> sparseflg set to 0'
       sparseflg = 0; pcond_flg = .false. ! pcond_flg = .false. ==> there is no preconditioner
    endif

    write(*,100)'           >>>  BICGSTABL Iterative Solver <<<'    
    call bicgstabl(ldim,nbelt,solvec,.false.,rhs,mat_vec,ilu0_l_pcond, &
                   pcond_flg,tol,nmatvec,info) ! Iterative solution of the Discretized BIE
    deallocate(g,rhs)

    if ( pcond_flg ) then
          deallocate(igcsr,jgcsr,gcsr)
    endif

    write(*,*) 'nmatvec ==', nmatvec
    write(*,*) 'Residual ==', tol
    write(*,*) 'err ==', info

    loop5: do k=1,nbelt
          if (eltbc(k) == 0) then ! eltbc(k) = 0 ==> Dirichlet data is prescribed on element k
             flx(k) = solvec(k)
          else ! eltbc(k) = 1 ==> Neumann data is prescribed on element k
             phi(k) = solvec(k)
          endif
    enddo loop5
	
   deallocate(solvec,eltbc)

   if ( sparseflg /= 0 ) then
        loop6: do k=1,ncwelt ! Loop over all non-empty Cells
           deallocate(cell(cwelt(k))%elt_id)
	   if ( sparseflg > 1) deallocate(cell(cwelt(k))%nbor)
        enddo loop6
        deallocate(cell,cwelt)
   endif


  100 format (1x, a)

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE cbem_lap_solv
!----------------------------------------------------------------------------------------------------------------------------------!
