!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_lap_solv
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

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

!*** Developer: Sylvain Nintcheu Fata
!*** Version:   V.1.1
!*** Released:  Jun 14, 2012


USE KINDS
USE SRF_GEOM, ONLY: nmltplnd   ! nmltplnd == Number of Multiple nodes (or Number of class of Multiple Nodes) on the boundary mesh
USE SRF_GEOM, ONLY: mltplnd    ! mltplnd(k) == Structure containing information about the k-th class of multiple nodes
USE SRF_GEOM, ONLY: nbnd       ! nbnd == Total number of boundary nodes
USE SRF_COND, ONLY: ndbc       ! ndbc(i) = {0,1} ==> {Dirichlet,Neunamm} boundary condition is prescribed at boundary node bnd(:,i)
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 CELL_ARP, ONLY: ncwnd      ! ncwnd == Number of computional Cells containing boundary nodes <==> number of non-empty cells
USE CELL_ARP, ONLY: cwnd,cell  ! cwnd(k) == Global index of the k-th non-empty cell
			       ! cell(k) == Structure containing information about the k-th cell
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 Neighboring interactions
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(nbnd),STAT=alloc_st) 
    if (alloc_st == 0) then ! If solvec is successfully allocated
          loop0: do k=1,nbnd
             solvec(k) = 0.0_dp
          enddo loop0
    else
          write(*,*)'gbem_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 gbem_cell_init ! Construct the computational box and distribute without repetition boundary nodes into cells,
	                      ! i.e, Initialize non-empty cells in arrays cell and cwnd, define the parameter ncwnd
	  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,ncwnd ! Loop over all non-empty cells
	           nk = cell(cwnd(k))%nnc ! nk = Number of boundary nodes 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,ncwnd ! Loop over all non-empty cells
			 kk = cwnd(k) ! kk == Global index of the k-th cell
			 nk = cell(kk)%nnc ! nk = Number of boundary nodes in the k-th cell
			 loop2b: do l=1,nk ! Loop over all boundary nodes in the k-th cell
			    loop2c: do i=1,nk ! Loop over all boundary nodes in the k-th cell
				gcsr(ii) = g(cell(kk)%nd_id(i),cell(kk)%nd_id(l)) ! Here gcsr is stored in COOrdinate (COO) format
			       igcsr(ii) = cell(kk)%nd_id(i) ! igcsr(ii) =    Row index in g of the ii entry of gcsr
			       jgcsr(ii) = cell(kk)%nd_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(*,*)'gbem_lap_solv: C1: Allocate arrays "igcsr,jgcsr,gcsr" failed with Status =',alloc_st
		      stop
		endif

	  else ! sparseflg > 1
		call gbem_cell_neighbor ! For all cell, find near-neighbors
                nnz_gcsr = 0
	        loop3a: do k=1,ncwnd ! Loop over all non-empty cells
	           nk = cell(cwnd(k))%nnc ! nk = Number of boundary nodes in the k-th cell
		   if ( cell(cwnd(k))%nnnc .ge. sparseflg ) then
		         cell(cwnd(k))%nnbsprs = sparseflg    
		   else ! cell(cwnd(k))%nnnc == Number of Near-neighboring cells to the k-th cell including the k-th cell itself
		        cell(cwnd(k))%nnbsprs = cell(cwnd(k))%nnnc ! cell(cwnd(k))%nnbsprs == Number of Near-Neighboring cells to 
			                                           !                           the k-th cell used to define gcsr
		   endif
		   
		   loop3b: do j=1,cell(cwnd(k))%nnbsprs ! Loop over the near-neighboring cells to the k-th cell
                                          ! cell(cwnd(k))%nbor(j) == Global index of the j-th near-neighboring cell to the k-th cell
 		       nj = cell(cell(cwnd(k))%nbor(j))%nnc ! nj == Number of boundary 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,ncwnd ! Loop over all non-empty cells
			 kk = cwnd(k) ! kk == Global index of the k-th cell
			 nk = cell(kk)%nnc ! nk = Number of boundary 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)%nnc ! nj == Number of boundary nodes in the j-th cell

			    loop4c: do l=1,nj ! Loop over all boundary nodes in the j-th cell
			       loop4d: do i=1,nk ! Loop over all boundary nodes in the k-th cell
				   gcsr(ii) = g(cell(kk)%nd_id(i),cell(jj)%nd_id(l)) ! Here gcsr is stored in COOrdinate (COO) format
			          igcsr(ii) = cell(kk)%nd_id(i) ! igcsr(ii) =    Row index in g of the ii entry of gcsr
			          jgcsr(ii) = cell(jj)%nd_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(*,*)'gbem_lap_solv: C2: Allocate arrays "igcsr,jgcsr,gcsr" failed with Status =',alloc_st
		      stop
		endif
	  endif ! sparseflg > 1
	  
	call coo2csr(nbnd,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(nbnd,gcsr,igcsr(1:nbnd+1),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,nbnd,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,nbnd
       if (ndbc(k) == 0) then ! ndbc(k) = 0 ==> Dirichlet data is prescribed at the k-th boundary node
          flx(k) = solvec(k)
       else ! ndbc(k) = 1 ==> Neumann data is prescribed at the k-th boundary node
          phi(k) = solvec(k)
       endif
    enddo loop5
    
    deallocate(solvec,ndbc)

    if (sparseflg /= 0) then
       loop6: do k=1,ncwnd ! Loop over all non-empty Cells
          deallocate(cell(cwnd(k))%nd_id) ! cwnd(k) = Global index of the k-th cell with boundary nodes
	  if (sparseflg > 1) deallocate(cell(cwnd(k))%nbor)
       enddo loop6
       deallocate(cell,cwnd)
    endif


    if (nmltplnd /= 0) then
         loop7a: do k=1,nmltplnd ! Loop over all class of multiple nodes
	    if (mltplnd(k)%pnd /= -1) then ! if there exist in the k-th class a boundary node with Global
	                                   ! index mltplnd(k)%pnd at which the potential is prescribed
	       loop7b: do j=1,mltplnd(k)%nn ! Loop over all multiple nodes in the k-th class
		  phi(mltplnd(k)%id(j)) = phi(mltplnd(k)%pnd) ! Retrieve prescribed potential from the boundary node mltplnd(k)%pnd
	       enddo loop7b
	    else ! there is no potential node in the k-th class of equivalence: ONLY flux nodes in the k-th class
	       loop7c: do j=2,mltplnd(k)%nn ! Loop over the remaining nodes in the k-th class of multiple nodes
		  phi(mltplnd(k)%id(j)) = phi(mltplnd(k)%id(1)) ! Assign potential by continuity
	       enddo loop7c
	    endif
	    deallocate(mltplnd(k)%id)
         enddo loop7a
        deallocate(mltplnd)
    endif

  100 format (1x, a)

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE gbem_lap_solv
!----------------------------------------------------------------------------------------------------------------------------------!
