!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_lap_init
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!**********************************  GALERKIN BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  **********************************!
!************************************  3-NODED TRIANGULAR ELEMENT: SEMI-ANALYTIC INTEGRATION  *************************************!
!************************************************  PIECEWISE LINEAR APPROXIMATION  ************************************************!
!***********************************************  Initialize arrays and parameters  ***********************************************!
!**********************************************************************************************************************************!

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


!*** Typical triangular element with vertices {y1,y2,y3}

!           y3
!	    *
!	   / \
!	  /   \
!	 /     \
!       /       \
!      /	 \
!     /		  \
!    *-------------*
!  y1               y2

! Oriented edge L1 = [y1,y2] <== Edge1
! Oriented edge L2 = [y2,y3] <== Edge2
! Oriented edge L3 = [y3,y1] <== Edge3

 
USE KINDS
USE PARAMS,   ONLY: pi,pix2,fac  ! pi = 3.1415926535897932, pix2 = 2*pi, fac == Factor of the Green's function: fac = 1/(4*pi)
USE SRF_GEOM, ONLY: mx_nd_elt    ! mx_nd_elt == Maximum number of nodes per element
USE SRF_GEOM, ONLY: nbelt        ! nbelt == Total number of boundary elements
USE SRF_GEOM, ONLY: belt         ! belt(:,i) == Global indices of boundary nodes on the i-th element
USE SRF_GEOM, ONLY: qq           ! qq(k) == Global index of the k-th node of the boundary element Q
USE SRF_GEOM, ONLY: bnd          ! bnd(:,i) == Cartesian coordinates of the i-th boundary node
USE SRF_GEOM, ONLY: LocCBasisElt ! LocCBasisElt(1:9,k) == Local Companion Basis associated with the k-th boundary element
USE SRF_GEOM, ONLY: xvElt,zvElt  ! xvElt(1,k) == Base of the k-th boundary element
				 ! xvElt(2,k) == Geometric parameter associated with the k-th boundary element
				 ! zvElt(k) == Height of the k-th boundary element
USE SRF_GEOM, ONLY: thetaElt     ! thetaElt(i,k) == Angle at the i-th vertex of the k-th boundary element
USE SRF_GEOM, ONLY: EltDiam      ! EltDiam(k) == Diameter of the k-th boundary element
USE SRF_GEOM, ONLY: EltAreax2    ! EltAreax2(k) = 2*Area of the k-th boundary element
USE SRF_GEOM, ONLY: shfe1,shfe2  ! shfe1(l,k,i) == l-th shape function evaluated at Gauss point (k,i) for edge-adjacent case: E'
				 ! shfe2(l,k,i) == l-th shape function evaluated at Gauss point (k,i) for edge-adjacent case: E"
USE SRF_GEOM, ONLY: shfv	 ! shfv(l,k,i) == l-th shape function evaluated at Gauss point (k,i) for vertex-adjacent case
USE GAUSS1D,  ONLY: ng1,xi1      ! ng1 == Number of Gauss-Legendre points over a segment [0,1] for Singular integrations
				 ! xi1 == Gauss-Legendre points over a segment [0,1] for Singular integrations
USE GAUSS1D,  ONLY: ng2,xi2      ! ng2 == Number of Gauss-Legendre points over a segment [0,1] for Quasi-singular integration
				 ! xi2 == Gauss-Legendre points over a segment [0,1] for Quasi-singular integration
USE GAUSS1D,  ONLY: ng3,xi3      ! ng3 == Number of Gauss-Legendre points over a segment [0,1] for Non-singular integration
				 ! xi3 == Gauss-Legendre points over a segment [0,1] for Non-singular integration
USE GAUSS1D,  ONLY: wwg1 ! wwg1(k,i) = wg1(i)*wg1(k), where wg1(k) is the k-th Gauss-Legendre weight factor corresponding to xi1(k)
USE GAUSS1D,  ONLY: wwg2 ! wwg2(k,i) = wg2(i)*wg2(k), where wg2(k) is the k-th Gauss-Legendre weight factor corresponding to xi2(k)
USE GAUSS1D,  ONLY: wwg3 ! wwg3(k,i) = wg3(i)*wg3(k), where wg3(k) is the k-th Gauss-Legendre weight factor corresponding to xi3(k)


IMPLICIT NONE

 integer(kind=k9) :: i,k,elQ ! elQ == Global index of the boundary element Q
 integer(kind=k9) :: alloc_st,alloc_st1,alloc_st2
 real   (kind=dp) :: d12,d13,d23
 real   (kind=dp) :: aQ,bQ,cQ ! Geometric parameters of element Q: bQ = base, aQ = height,
 			      ! cQ = relative position of the 3rd vertex of element Q in the local basis {e1,e2,e3}
 real   (kind=dp) :: x,y,xy,xyhlf,aQs,bmc
 real   (kind=dp) :: vij(3,3),ym1hlf,yp1hlf,xm1,ym1
 real   (kind=dp) :: e1(3),e2(3),e3(3) ! Orthonormal local basis
 real   (kind=dp), pointer :: wg1(:) ! Gauss-Legendre weight factors for Singular (Edge-adjacent and Vertex-adjacent) integrations
 real   (kind=dp), pointer :: wg2(:) ! Gauss-Legendre weight factors for Quasi-singular integration
 real   (kind=dp), pointer :: wg3(:) ! Gauss-Legendre weight factors for Non-singular integration



    pi = 4.0_dp*datan(1.0_dp) ! pi = 3.1415926535897932
    pix2 = 2.0_dp*pi; fac = 1.0_dp/(4.0_dp*pi) ! fac == Factor of the Green's function

    allocate(EltDiam(nbelt),EltAreax2(nbelt),STAT=alloc_st)
    allocate(xvElt(2,nbelt),zvElt(nbelt),thetaElt(3,nbelt),STAT=alloc_st1)
    allocate(LocCBasisElt(9,nbelt),STAT=alloc_st2)


    if ( (alloc_st == 0) .and. (alloc_st1 == 0) .and. (alloc_st2 == 0) ) then ! If EltDiam, EltAreax2, xvElt, zvElt, thetaElt, 
    									      ! LocCBasisElt are successfully allocated

!** Find Diameter, Companion Basis and Area of each boundary element ******************************!
 	  loop0a: do elQ=1,nbelt ! loop over all boundary elements
 	     loop0b: do i=1,mx_nd_elt ! Loop over the nodes of element Q
 	  	qq(i) = belt(i,elQ) ! p(i) == Global index of the i-th node (vertex) of the boundary element Q
 	     enddo loop0b

	      loop0c: do k=1,3 ! Loop over all components
	  	 vij(k,1) = bnd(k,qq(2))-bnd(k,qq(1)) ! y2-y1 <== Side 1 of element Q
	  	 vij(k,2) = bnd(k,qq(3))-bnd(k,qq(2)) ! y3-y2 <== Side 2 of element Q
	  	 vij(k,3) = bnd(k,qq(3))-bnd(k,qq(1)) ! y3-y1 <== Side 3 of element Q
	      enddo loop0c

	  	d12 = vij(1,1)*vij(1,1) + vij(2,1)*vij(2,1) + vij(3,1)*vij(3,1)
	  	d23 = vij(1,2)*vij(1,2) + vij(2,2)*vij(2,2) + vij(3,2)*vij(3,2)
	  	d13 = vij(1,3)*vij(1,3) + vij(2,3)*vij(2,3) + vij(3,3)*vij(3,3)

	  	EltDiam(elQ) = dsqrt(max(d12,d13,d23)) ! EltDiam(elQ) == Diameter of the boundary element Q

!*** LocCBasisElt(:,elQ) = {e1,e2,e3} == Local orthonormal companion basis associated with the boundary element Q
!*** {e1,e2} = Orthonormal System in the plane of the boundary element Q
!*** e3 = vector characterizing the unit "outward" normal to element Q
		call ortho_comp_basis(vij(:,1),vij(:,3),e1,e2,e3) ! Deternime the orthonormal companion basis associated with element Q
 	  	LocCBasisElt(1,elQ) = e1(1); LocCBasisElt(2,elQ) = e1(2); LocCBasisElt(3,elQ) = e1(3)
 	  	LocCBasisElt(4,elQ) = e2(1); LocCBasisElt(5,elQ) = e2(2); LocCBasisElt(6,elQ) = e2(3)
 	  	LocCBasisElt(7,elQ) = e3(1); LocCBasisElt(8,elQ) = e3(2); LocCBasisElt(9,elQ) = e3(3)

 	  	bQ = vij(1,1)*e1(1) + vij(2,1)*e1(2) + vij(3,1)*e1(3) ! bQ>0.0 always
	        aQ = vij(1,3)*e2(1) + vij(2,3)*e2(2) + vij(3,3)*e2(3) ! aQ>0.0 always
		cQ = vij(1,3)*e1(1) + vij(2,3)*e1(2) + vij(3,3)*e1(3)

	  	xvElt(1,elQ) = bQ; xvElt(2,elQ) = cQ; zvElt(elQ) = aQ
		
 	      EltAreax2(elQ) = bQ*aQ ! EltAreax2(elQ) = 2*Area of element Q

!*** thetaElt(i,elQ) == Angle at the i-th vertex of element Q
	      bmc = bQ-cQ; aQs = aQ*aQ
	      thetaElt(1,elQ) = dacos(cQ/dsqrt(cQ*cQ + aQs))
	      thetaElt(2,elQ) = dacos(bmc/dsqrt(bmc*bmc + aQs))
	      thetaElt(3,elQ) = pi - (thetaElt(1,elQ)+thetaElt(2,elQ))
 	  enddo loop0a
!** End Find Diameter, Companion Basis and Area of each boundary element **************************!

    else
          if ( alloc_st /= 0 ) then  ! If EltDiam, EltAreax2 are not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate arrays "EltDiam, EltAreax2" failed with Status=',alloc_st
	        stop
          endif

          if ( alloc_st1 /= 0 ) then  ! If xvElt, zvElt, thetaElt are not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate arrays "xvElt, zvElt, thetaElt" failed with Status=',alloc_st1
	        stop
          endif

          if ( alloc_st2 /= 0 ) then  ! If LocCBasisElt is not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate array "LocCBasisElt" failed with Status=',alloc_st2
	        stop
          endif
    endif

!** Set Gauss-Legendre quadrature ********************************************************************************!
    allocate(xi1(ng1),wg1(ng1),STAT=alloc_st)  ! Gauss-Legendre points and weights for Singular integrations
    allocate(xi2(ng2),wg2(ng2),STAT=alloc_st1) ! Gauss-Legendre points and weights for Quasi-singular integration
    allocate(xi3(ng3),wg3(ng3),STAT=alloc_st2) ! Gauss-Legendre points and weights for Non-singular integration

    if ( (alloc_st == 0) .and. (alloc_st1 == 0) .and. (alloc_st2 == 0) ) then ! If xi1,wg1, xi2,wg2, xi3,wg3 are successfully allocated
          call rgauleg(0.0_dp,1.0_dp,xi1,wg1,ng1) ! Generate ng1 Gauss-Legendre points and weights for integration over a segment [0,1]
          call rgauleg(0.0_dp,1.0_dp,xi2,wg2,ng2) ! Generate ng2 Gauss-Legendre points and weights for integration over a segment [0,1]
          call rgauleg(0.0_dp,1.0_dp,xi3,wg3,ng3) ! Generate ng3 Gauss-Legendre points and weights for integration over a segment [0,1]
    else
          if ( alloc_st /= 0 ) then  ! If xi1,wg1 are not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate arrays "xi1,wg1" failed with Status=',alloc_st
	        stop
          endif

          if ( alloc_st1 /= 0 ) then  ! If xi2,wg2 are not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate arrays "xi2,wg2" failed with Status=',alloc_st1
	        stop
          endif

          if ( alloc_st2 /= 0 ) then  ! If xi3,wg3 are not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate arrays "xi3,wg3" failed with Status=',alloc_st2
	        stop
          endif
    endif
!** END Set Gauss-Legendre quadrature ****************************************************************************!


!** Initialize Gauss weights for Non-singular (i.e. Well-separated element pair) integration ************************!
    allocate(wwg3(ng3,ng3),STAT=alloc_st)

    if ( alloc_st == 0 ) then ! If wwg3 is successfully allocated
 	  loop1a: do i = 1,ng3 ! Loop over all Gauss points
	     loop1b: do k = 1,ng3 ! Loop over all Gauss points
	  	wwg3(k,i) = wg3(i)*wg3(k)
 	     enddo loop1b
 	  enddo loop1a
 	  deallocate(wg3)
    else
          if ( alloc_st /= 0 ) then ! If wwg3 is not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate array "wwg3" failed with Status=',alloc_st
	        stop
          endif
    endif
!** End Initialize Gauss weights for Non-singular (i.e. Well-separated element pair) integration ********************!


!** Initialize Gauss weights for Quasi-singular integration ***************************************!
    allocate(wwg2(ng2,ng2),STAT=alloc_st)

    if ( alloc_st == 0 ) then ! If wwg2 is successfully allocated
 	  loop2a: do i = 1,ng2 ! Loop over all Gauss points
	     loop2b: do k = 1,ng2 ! Loop over all Gauss points
	  	wwg2(k,i) = wg2(i)*wg2(k)
 	     enddo loop2b
 	  enddo loop2a
 	  deallocate(wg2)
    else
          if ( alloc_st /= 0 ) then ! If wwg2 is not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate array "wwg2" failed with Status=',alloc_st
	        stop
          endif
    endif
!** End Initialize Gauss weights for Quasi-singular integration ***********************************!


!** Initialize Gauss weights and shape functions for Singular integrations ************************!
    allocate(wwg1(ng1,ng1),STAT=alloc_st)
    allocate(shfv(mx_nd_elt,ng1,ng1),shfe1(mx_nd_elt,ng1,ng1),shfe2(mx_nd_elt,ng1,ng1),STAT=alloc_st1)

    if ( (alloc_st == 0) .and. (alloc_st1 == 0) ) then ! If wwg1,shfv,shfe1,shfe2 are successfully allocated
 	  loop3a: do i = 1,ng1 ! Loop over all Gauss points
	     loop3b: do k = 1,ng1 ! Loop over all Gauss points
	  	wwg1(k,i) = wg1(i)*wg1(k)
	  	x = xi1(k); y = xi1(i)
	  	ym1 = 1.0_dp-y; xm1 = 1.0_dp-x; xy = x*y
	  	xyhlf = 0.5_dp*xy; ym1hlf = 0.5_dp*ym1; yp1hlf = 0.5_dp*(1.0_dp+y)

	  	shfv(1,k,i) = xm1; shfv(2,k,i) = x*ym1; shfv(3,k,i) = xy ! shape functions for vertex-adjacent case
	  	shfe1(1,k,i)= xyhlf; shfe1(2,k,i) = xm1 + xyhlf; shfe1(3,k,i) = x*ym1 ! shape functions for edge-adjacent case: E'
	  	shfe2(1,k,i)= 1.0_dp-x*yp1hlf; shfe2(2,k,i) = x*ym1hlf; shfe2(3,k,i) = xy ! shape functions for edge-adjacent case: E"
	
 	     enddo loop3b
 	  enddo loop3a
 	  deallocate(wg1)
    else
          if ( alloc_st /= 0 ) then ! If wwg1 is not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate array "wwg1" failed with Status=',alloc_st
	        stop
          endif

          if ( alloc_st1 /= 0 ) then ! If shfv,shfe1,shfe2 are not successfully allocated 
                write(*,*)'gbem_lap_init: Allocate arrays "shfv,shfe1,shfe2" failed with Status=',alloc_st1
	        stop
          endif
    endif 
!** End Initialize Gauss weights and shape functions for Singular integrations ********************!

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE gbem_lap_init
!----------------------------------------------------------------------------------------------------------------------------------!
