!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_lap_lrhs
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!**********************************  GALERKIN BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  **********************************!
!************************************  3-NODED TRIANGULAR ELEMENT: SEMI-ANALYTIC INTEGRATION  *************************************!
!************************************************  PIECEWISE LINEAR APPROXIMATION  ************************************************!
!**********************************  Form the left- and right-hand sides of 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 the i-th boundary node
USE DISCR_BIE, ONLY: h,g      ! h == Potential influence matrix, g == Flux influence matrix
USE DISCR_BIE, ONLY: rhs      ! rhs == Right-hand side of the Discretized BIE
USE POTFLUX,   ONLY: phi,flx  ! phi == Vector containing boundary potentials, flx == Vector containing boundary fluxes
USE POTFLUX,   ONLY: pbv      ! pbv == Vector containing Prescribed Boundary Values


IMPLICIT NONE

 integer(kind=k9) :: i,j,k,l,n,alloc_st



!*** Initialization: Prescribed boundary conditions ==> flux and potential vectors
    allocate(phi(nbnd),flx(nbnd),STAT=alloc_st) 
    if (alloc_st == 0) then ! If phi,flx are successfully allocated
       loop0: do k=1,nbnd ! Loop over all boundary nodes
         if (ndbc(k) == 0) then ! ndbc(k) = 0 ==> Dirichlet data is prescribed at the k-th boundary node
           phi(k) = pbv(k); flx(k) = 0.0_dp
         else ! ndbc(k) = 1 ==> Neumann data is prescribed at the k-th boundary node
           phi(k) = 0.0_dp; flx(k) = pbv(k)
         endif
       enddo loop0
    else
          write(*,*)'gbem_lap_lrhs: Allocate arrays "phi,flx" failed with Status=',alloc_st
	  stop
    endif
       
    deallocate(pbv)

    call mltpl_nd ! Find Multiple nodes on the boundary mesh
    call mnd_ptl  ! Find a boundary node in every class of multiple nodes at which the potential is prescribed

    if (nmltplnd /= 0) then ! If there are multiple nodes on the boundary mesh
      loop1a: 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 node with Global index mltplnd(k)%pnd at
				        ! which the potential is prescribed
	    loop1b: 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) ! Assign potential by continuity
	    enddo loop1b
	 endif
      enddo loop1a
    endif 

    allocate(rhs(nbnd),STAT=alloc_st)
    if (alloc_st == 0) then ! If rhs is successfully allocated
       ! rhs = matmul(h,phi) - matmul(g,flx)
       call dgemv('N',nbnd,nbnd,1.0_dp,g,nbnd,flx,1, 0.0_dp,rhs,1) ! rhs = matmul(g,flx)
       call dgemv('N',nbnd,nbnd,1.0_dp,h,nbnd,phi,1,-1.0_dp,rhs,1) ! rhs = matmul(h,phi) - rhs
    else
       write(*,*)'gbem_lap_lrhs: Allocate array "rhs" failed with Status=',alloc_st
       stop
    endif

!*** Rearrange columns: Form the Left-hand side coefficient matrix in g
    loop2a: do k=1,nbnd ! Loop over all boundary nodes
       if(ndbc(k) == 1) then ! if Neumann data is prescribed at the k-th boundary node
          loop2b: do i=1,nbnd ! Loop over all boundary nodes
	     g(i,k) = -h(i,k)
	  enddo loop2b
       endif
    enddo loop2a

    deallocate(h)


!*** Enforcing continuity of potentials in g
    if (nmltplnd /= 0) then ! if the surface mesh has Multiple nodes
       loop3a: 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 node with Global index mltplnd(k)%pnd at
				         ! which the potential is prescribed
	     loop3b: do j=1,mltplnd(k)%nn ! Loop over all multiple nodes in the k-th class
	        i = mltplnd(k)%id(j) ! i = Global index of the j-th node in the k-th class of multiple nodes
	        if (ndbc(i) == 1) then ! if the flux is prescribed at the i-th boundary node
		   loop3c: do l=1,nbnd ! Loop over all boundary nodes
		      g(l,i) = 0.0_dp;  g(i,l) = 0.0_dp
		   enddo loop3c 
		   g(i,i) = 1.0_dp; rhs(i) = phi(mltplnd(k)%pnd)
		endif
	     enddo loop3b
	  else ! there is no potential node in the k-th class of multiple nodes ==> ONLY flux nodes in the k-th class
	     i = mltplnd(k)%id(1) ! i = Global index of the 1st node in the k-th class of multiple nodes
	     loop3d: do j=2,mltplnd(k)%nn ! Loop over the remaining nodes in the k-th class of multiple nodes
	        l = mltplnd(k)%id(j) ! l = Global index of the j-th node in the k-th class of multiple nodes
		  loop3e: do n=1,nbnd ! Loop over all boundary nodes
		     g(n,i) = g(n,i) + g(n,l) ! add columns
		     g(n,l) = 0.0_dp
		  enddo loop3e

		  loop3f: do n=1,nbnd ! Loop over all boundary nodes
		     g(i,n) = g(i,n) + g(l,n) ! add rows
		     g(l,n) = 0.0_dp
		  enddo loop3f
		  g(l,l) = 1.0_dp; rhs(i) = rhs(i) + rhs(l); rhs(l) = 0.0_dp
	     enddo loop3d
	  endif
       enddo loop3a
    endif

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE gbem_lap_lrhs
!----------------------------------------------------------------------------------------------------------------------------------!


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE mnd_ptl
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!*********************************************  GALERKIN BEM for 3D LAPLACE EQUATION  *********************************************!
!******************  Find a boundary node in every class of multiple nodes at which the potential is prescribed  ******************!
!**********************************************************************************************************************************!

!*** 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_COND, ONLY: ndbc     ! ndbc(i) = {0,1} ==> {Dirichlet,Neunamm} boundary condition is prescribed at the i-th boundary node


IMPLICIT NONE

 integer(kind=k9) :: i,j



    if (nmltplnd /= 0) then ! if the surface mesh has Multiple nodes
 	 loop0a: do i=nmltplnd,1,-1 ! Loop over all multiple nodes
!*** Find a boundary node in the i-th class of multiple nodes at which the potential is prescribed
	     j=1
	     loop0b: do
	 	if (ndbc(mltplnd(i)%id(j)) == 0) then
	 	  mltplnd(i)%pnd = mltplnd(i)%id(j) ! There is in the i-th class a node with global index mltplnd(i)%pnd
	 					    ! at which the potential is prescribed
	 	  exit
	 	elseif (j == mltplnd(i)%nn) then
	 	  mltplnd(i)%pnd = -1 ! There is no potential node in the i-th class of multiple nodes
	 	  exit
	 	else
	 	  j = j+1
	 	endif
	     enddo loop0b
!*** End Find a boundary node in the i-th class of multiple nodes at which the potential is prescribed
 	 enddo loop0a
    endif

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE mnd_ptl
!----------------------------------------------------------------------------------------------------------------------------------!
