!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_lap_iex_int_v(elP,elQ)
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!**********************************  GALERKIN BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  **********************************!
!************************************  3-NODED TRIANGULAR ELEMENT: SEMI-ANALYTIC INTEGRATION  *************************************!
!************************************************  PIECEWISE LINEAR APPROXIMATION  ************************************************!
!*******************************  EXact Inner integral with linear distribution on a flat triangle  *******************************!
!*************************************************  Vertex-adjacent integration  **************************************************!
!**********************************************************************************************************************************!

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

 
USE KINDS
USE PARAMS,   ONLY: pi           ! pi = 3.1415926535897932
USE SRF_GEOM, ONLY: mx_nd_elt    ! mx_nd_elt == Maximum number of nodes per element
USE SRF_GEOM, ONLY: belt         ! belt(:,i) == Global indices of boundary nodes on the i-th element
USE SRF_GEOM, ONLY: bnd          ! bnd(:,i) == Cartesian coordinates of the i-th boundary node
USE SRF_GEOM, ONLY: xeP,xeQ      ! xeP(:,k) == Cartesian coordinates of the k-th node of element P
			         ! xeQ(:,k) == Cartesian coordinates of the k-th node of element Q
USE SRF_GEOM, ONLY: PQmLocId     ! PQmLocId(1) == Local index of the vertex of element P that is adjacent to element Q
			         ! PQmLocId(2) == Local index of the vertex of element Q that is adjacent to element P
USE SRF_GEOM, ONLY: LocCBasisElt ! LocCBasisElt(1:9,k) == Local Companion Basis associated with 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: pp,qq        ! pp(k) == Global index of the k-th node of the boundary element P
				 ! qq(k) == Global index of the k-th node of the boundary element Q
USE DISCR_BIE,ONLY: int_p,int_f  ! int_p == Local contribution for potential influence matrix
				 ! int_f == Local contribution for flux influence matrix
USE DISCR_BIE,ONLY: int_r        ! int_r == Local contribution for potential/flux influence matrix
USE DISCR_BIE,ONLY: h,g          ! h == Potential influence matrix, g == Flux influence matrix


IMPLICIT NONE

 integer(kind=k9), intent(in) :: elP ! elP == Global index of the outer boundary element P
 integer(kind=k9), intent(in) :: elQ ! elQ == Global index of the inner boundary element Q

 integer(kind=k9) :: k,i,row,col
 integer(kind=k9) :: PcoincidentVertex,QcoincidentVertex
 real   (kind=dp) :: e1P(3),e2P(3),e3P(3) ! Orthonormal companion basis associated with element P
 real   (kind=dp) :: e1Q(3),e2Q(3),e3Q(3) ! Orthonormal companion basis associated with element Q
 real   (kind=dp) :: e1(3),e2(3) ! Orthonormal local basis
 real   (kind=dp) :: aP,bP,cP ! Geometric parameters of element P: bP = base, aP = height, 
 			      ! cP = relative position of the 3rd vertex of element P in the local basis {e1P,e2P,e3P}
 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 {e1Q,e2Q,e3Q}
 real   (kind=dp) :: QPTransitionMtrx(3,3)
 real   (kind=dp) :: vij(3,2),theta(3),alpha(3),alphaEltP(3),calpk,salpk,x



    PcoincidentVertex = PQmLocId(1); QcoincidentVertex = PQmLocId(2) ! Vertex "PcoincidentVertex" of element P coincides
								     ! with Vertex "QcoincidentVertex" of element Q


!*** Geometry of the inner element Q
    loop0a: do k=1,mx_nd_elt ! Loop over the nodes of element Q
       qq(k) = belt(k,elQ) ! qq(k) == Global index of the k-th node of the inner boundary element Q
       loop0b: do i=1,3 ! Loop over all components
          xeQ(i,k) = bnd(i,qq(k)) ! xeQ(:,k) == Cartesian coordinates of the k-th node of element Q
       enddo loop0b
    enddo loop0a

     e1(1) = LocCBasisElt(1,elQ);  e1(2) = LocCBasisElt(2,elQ);  e1(3) = LocCBasisElt(3,elQ)
     e2(1) = LocCBasisElt(4,elQ);  e2(2) = LocCBasisElt(5,elQ);  e2(3) = LocCBasisElt(6,elQ)
    e3Q(1) = LocCBasisElt(7,elQ); e3Q(2) = LocCBasisElt(8,elQ); e3Q(3) = LocCBasisElt(9,elQ)

    theta(1) = thetaElt(1,elQ); theta(2) = thetaElt(2,elQ); theta(3) = thetaElt(3,elQ)

    alpha(1) = 0.0_dp; alpha(2) = pi-theta(2); alpha(3) = pi+theta(1)
    
!*** Reorder the node numbers of element Q so that the node with local index 1 coincides with the node of element Q
!*** that is adjacent to element P, i.e., consider the permutation of node numbers of the inner element Q
     if (QcoincidentVertex == 1) then ! (/1,2,3/) ==> (/1,2,3/)

	  loop1: do k=1,3 ! Loop over all components
	     e1Q(k) = e1(k); e2Q(k) = e2(k)
	  enddo loop1

     elseif(QcoincidentVertex == 2) then ! (/1,2,3/) ==> (/2,3,1/)

	  loop2: do k=1,3 ! Loop over all components
	     x = xeQ(k,1)
	     xeQ(k,1) = xeQ(k,2)
	     xeQ(k,2) = xeQ(k,3)
	     xeQ(k,3) = x
	  enddo loop2
	  k = qq(1);     x = theta(1)
	  qq(1) = qq(2); theta(1) = theta(2)
	  qq(2) = qq(3); theta(2) = theta(3)
	  qq(3) = k;     theta(3) = x

	calpk = dcos(alpha(2)); salpk = dsin(alpha(2))

        loop3: do k=1,3 ! loop over all components
           e1Q(k) = calpk*e1(k) + salpk*e2(k)
           e2Q(k) = calpk*e2(k) - salpk*e1(k)
        enddo loop3

     else ! QcoincidentVertex == 3: (/1,2,3/) ==> (/3,1,2/)

	  loop4: do k=1,3 ! Loop over all components
	     x = xeQ(k,1)
	     xeQ(k,1) = xeQ(k,3)
	     xeQ(k,3) = xeQ(k,2)
	     xeQ(k,2) = x
	  enddo loop4
	  k = qq(1);     x = theta(1)
	  qq(1) = qq(3); theta(1) = theta(3)
	  qq(3) = qq(2); theta(3) = theta(2)
	  qq(2) = k;     theta(2) = x

	calpk = dcos(alpha(3)); salpk = dsin(alpha(3))

        loop5: do k=1,3 ! loop over all components
           e1Q(k) = calpk*e1(k) + salpk*e2(k)
           e2Q(k) = calpk*e2(k) - salpk*e1(k)
        enddo loop5

     endif

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

    bQ = vij(1,1)*e1Q(1) + vij(2,1)*e1Q(2) + vij(3,1)*e1Q(3) ! bQ>0.0_dp always
    aQ = vij(1,2)*e2Q(1) + vij(2,2)*e2Q(2) + vij(3,2)*e2Q(3) ! aQ>0.0_dp always
    cQ = vij(1,2)*e1Q(1) + vij(2,2)*e1Q(2) + vij(3,2)*e1Q(3)


!*** Geometry of the outer element P
    loop7a: do k=1,mx_nd_elt ! Loop over the nodes of element P
       pp(k) = belt(k,elP) ! pp(k) == Global index of the k-th node of the outer boundary element P
       loop7b: do i=1,3 ! Loop over all components
	  xeP(i,k) = bnd(i,pp(k)) ! xeP(:,k) == Cartesian coordinates of the k-th node of element P
       enddo loop7b   
    enddo loop7a
    
     e1(1) = LocCBasisElt(1,elP);  e1(2) = LocCBasisElt(2,elP);  e1(3) = LocCBasisElt(3,elP)
     e2(1) = LocCBasisElt(4,elP);  e2(2) = LocCBasisElt(5,elP);  e2(3) = LocCBasisElt(6,elP)
    e3P(1) = LocCBasisElt(7,elP); e3P(2) = LocCBasisElt(8,elP); e3P(3) = LocCBasisElt(9,elP)

    alphaEltP(1) = 0.0_dp; alphaEltP(2) = pi-thetaElt(2,elP); alphaEltP(3) = pi+thetaElt(1,elP)

!*** Reorder the node numbers of element P so that the node with local index 1 coincides with the node of element P
!*** that is adjacent to element Q, i.e., consider the permutation of node numbers of the outer element P
     if (PcoincidentVertex == 1) then ! (/1,2,3/) ==> (/1,2,3/)

	  loop8: do k=1,3 ! Loop over all components
	     e1P(k) = e1(k); e2P(k) = e2(k)
	  enddo loop8

     elseif(PcoincidentVertex == 2) then ! (/1,2,3/) ==> (/2,3,1/)

	  loop9: do k=1,3 ! Loop over all components
	     x = xeP(k,1)
	     xeP(k,1) = xeP(k,2)
	     xeP(k,2) = xeP(k,3)
	     xeP(k,3) = x
	  enddo loop9
	  k = pp(1)
	  pp(1) = pp(2)
	  pp(2) = pp(3)
	  pp(3) = k

        calpk = dcos(alphaEltP(2)); salpk = dsin(alphaEltP(2))

        loop10: do k=1,3 ! loop over all components
           e1P(k) = calpk*e1(k) + salpk*e2(k)
           e2P(k) = calpk*e2(k) - salpk*e1(k)
        enddo loop10

     else ! PcoincidentVertex == 3: (/1,2,3/) ==> (/3,1,2/)

	  loop11: do k=1,3 ! Loop over all components
	     x = xeP(k,1)
	     xeP(k,1) = xeP(k,3)
	     xeP(k,3) = xeP(k,2)
	     xeP(k,2) = x
	  enddo loop11
	  k = pp(1)
	  pp(1) = pp(3)
	  pp(3) = pp(2)
	  pp(2) = k

        calpk = dcos(alphaEltP(3)); salpk = dsin(alphaEltP(3))

        loop12: do k=1,3 ! loop over all components
           e1P(k) = calpk*e1(k) + salpk*e2(k)
           e2P(k) = calpk*e2(k) - salpk*e1(k)
        enddo loop12

     endif

    loop13: do k=1,3 ! Loop over all components
       vij(k,1) = xeP(k,2) - xeP(k,1) ! x2-x1 <== Side 1 of element P
       vij(k,2) = xeP(k,3) - xeP(k,1) ! x3-x1 <== Side 3 of element P
    enddo loop13

    bP = vij(1,1)*e1P(1) + vij(2,1)*e1P(2) + vij(3,1)*e1P(3) ! bP>0.0_dp always
    aP = vij(1,2)*e2P(1) + vij(2,2)*e2P(2) + vij(3,2)*e2P(3) ! aP>0.0_dp always
    cP = vij(1,2)*e1P(1) + vij(2,2)*e1P(2) + vij(3,2)*e1P(3)
    

!*** C_ij == Transition matrix from {e1Q,e2Q,e3Q} to {e1P,e2P,e3P}
!*** Projection (Transformation) of e1P to coordinate system {e1Q,e2Q,e3Q} local to elQ
          QPTransitionMtrx(1,1) = e1P(1)*e1Q(1) + e1P(2)*e1Q(2) + e1P(3)*e1Q(3) ! C_11
          QPTransitionMtrx(2,1) = e1P(1)*e2Q(1) + e1P(2)*e2Q(2) + e1P(3)*e2Q(3) ! C_21
	  QPTransitionMtrx(3,1) = e1P(1)*e3Q(1) + e1P(2)*e3Q(2) + e1P(3)*e3Q(3) ! C_31

!*** Projection (Transformation) of e2P to coordinate system {e1Q,e2Q,e3Q} local to elQ
          QPTransitionMtrx(1,2) = e2P(1)*e1Q(1) + e2P(2)*e1Q(2) + e2P(3)*e1Q(3) ! C_12
          QPTransitionMtrx(2,2) = e2P(1)*e2Q(1) + e2P(2)*e2Q(2) + e2P(3)*e2Q(3) ! C_22
	  QPTransitionMtrx(3,2) = e2P(1)*e3Q(1) + e2P(2)*e3Q(2) + e2P(3)*e3Q(3) ! C_32

!*** Projection (Transformation) of e3P to coordinate system {e1Q,e2Q,e3Q} local to elQ
          QPTransitionMtrx(1,3) = e3P(1)*e1Q(1) + e3P(2)*e1Q(2) + e3P(3)*e1Q(3) ! C_13
          QPTransitionMtrx(2,3) = e3P(1)*e2Q(1) + e3P(2)*e2Q(2) + e3P(3)*e2Q(3) ! C_23
	  QPTransitionMtrx(3,3) = e3P(1)*e3Q(1) + e3P(2)*e3Q(2) + e3P(3)*e3Q(3) ! C_33

     call sing_vtx(aP,bP,cP,aQ,bQ,cQ,theta,QPTransitionMtrx,int_p,int_f,int_r) ! Integration for vertex-adjacent elements

     loop15a: do col=1,mx_nd_elt ! Loop over the nodes of element Q
        loop15b: do row=1,mx_nd_elt ! Loop over the nodes of element P
           h(pp(row),qq(col)) = h(pp(row),qq(col)) + int_p(row,col)
	   g(pp(row),qq(col)) = g(pp(row),qq(col)) + int_f(row,col)

!*** Reverse Kernel
           h(qq(col),pp(row)) = h(qq(col),pp(row)) + int_r(row,col)
	   g(qq(col),pp(row)) = g(qq(col),pp(row)) + int_f(row,col)
        enddo loop15b
     enddo loop15a

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE gbem_lap_iex_int_v
!----------------------------------------------------------------------------------------------------------------------------------!


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE sing_vtx(a,b,c,aQ,bQ,cQ,theta,QPTM,int_p,int_f,int_r)
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!**********************************  GALERKIN BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  **********************************!
!************************************  3-NODED TRIANGULAR ELEMENT: SEMI-ANALYTIC INTEGRATION  *************************************!
!************************************************  PIECEWISE LINEAR APPROXIMATION  ************************************************!
!*******************************  EXact Inner integral with linear distribution on a flat triangle  *******************************!
!**************************************  Singular integration for vertex-adjacent elements  ***************************************!
!**********************************************************************************************************************************!

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

 
USE KINDS
USE PARAMS,   ONLY: pi,gm_eps ! pi = 3.1415926535897932, gm_eps == Tolerance on the geometry
USE SRF_GEOM, ONLY: mx_nd_elt ! mx_nd_elt == Maximum number of nodes per element
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: wwg1      ! wwg1(k,i) = wg1(i)*wg1(k), where wg1(k) is the k-th Gauss-Legendre weight factor corresponding to xi1(k)


IMPLICIT NONE

 real   (kind=dp), intent(in ) :: a,b,c    ! Geometric parameters of element P: b = base, a = height,
                                           ! c = relative position of the 3rd vertex of element P
 real   (kind=dp), intent(in ) :: aQ,bQ,cQ ! Geometric parameters of element Q: bQ = base, aQ = height, 
                                           ! cQ = relative position of the 3rd vertex of element Q
 real   (kind=dp), intent(in ) :: theta(3) ! theta(i) == Angle at the i-th vertex of element Q
 real   (kind=dp), intent(in ) :: QPTM(3,3) ! Transition matrix from element Q to element P
 real   (kind=dp), intent(out) :: int_p(mx_nd_elt,mx_nd_elt) ! int_p == Singular contribution to potential influence matrix H
 real   (kind=dp), intent(out) :: int_f(mx_nd_elt,mx_nd_elt) ! int_f == Singular contribution to flux influence matrix G
 real   (kind=dp), intent(out) :: int_r(mx_nd_elt,mx_nd_elt) ! int_r == Singular contribution to potential influence matrix H: Reverse kernel

 integer(kind=k9) :: k,kk,i,j,th_id
 real   (kind=dp) :: kQ2,kQ3 ! kQ2 == Slope of Edge2 of element Q, kQ3 == Slope of Edge3 of element Q
 real   (kind=dp) :: c11,c21,c31,c12,c22,c32,c13,c23,c33,p11,p11h,q1h,p12,p22,p23,p31,p33,x3,z3,rh1s,rh2s,rh3s,p12s,p33s,chis,chic
 real   (kind=dp) :: cmb,xh,zh,q1hs,et,eth,eths,ets,p31h,q3h,q3hs,c13cf,c23cf,d(3),q(3),qs(3),rho(3),rhowv(3),chi(3),gamma(3)
 real   (kind=dp) :: dlt,alpha2,alpha3,x,y,xww,xwpc,rho1h,rho1hs,q1heth,q3heth,q2et,p11hrho1h,p31hrho1h,hh1,hh3,omega,ethx2,ethx2s
 real   (kind=dp) :: cr11,cr12,zn1,zd1,cr22,cr23,zn2,zd2,cr31,cr33,zn3,zd3,p12rh2,p22rh2,p23rh3,p33rh3,theta0,ThetGam,etThetGam
 real   (kind=dp) :: vecA(3),vecB(3),sncf(2:3),cscf(2:3),ah(3,3),bh(3,3),qchi(3),etchi(3),dchi(3),qrhowv(3)
 real   (kind=dp) :: psi(mx_nd_elt),shc(mx_nd_elt),xwp(mx_nd_elt),intGamwv(mx_nd_elt),intclN(mx_nd_elt,3),intclM(mx_nd_elt,3)
 real   (kind=dp) :: intA(mx_nd_elt,3),intD(mx_nd_elt,3),intR(mx_nd_elt,2:3),intGN3tmp(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intOme(mx_nd_elt,mx_nd_elt),intGam(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intGK1(mx_nd_elt,mx_nd_elt),intGN1(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intGK2(mx_nd_elt,mx_nd_elt),intGN2(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intGK3(mx_nd_elt,mx_nd_elt),intGN3(mx_nd_elt,mx_nd_elt)

 real(kind=dp), external :: pt_tria_tst,gammai ! External functions (see gbem_util.f90)



     c11 = QPTM(1,1); c21 = QPTM(2,1); c31 = QPTM(3,1)
     c12 = QPTM(1,2); c22 = QPTM(2,2); c32 = QPTM(3,2)
     c13 = QPTM(1,3); c23 = QPTM(2,3); c33 = QPTM(3,3)

     if ( ((dabs(c13) < gm_eps) .and. (dabs(c23) < gm_eps)) .or. ((dabs(c31) < gm_eps) .and. (dabs(c32) < gm_eps)) ) then
          call svesp(a,b,c,aQ,bQ,cQ,theta,QPTM,int_p,int_f,int_r) ! Integration for vertex-adjacent elements on the same plane
	  return
     endif

     dlt = a*b; cmb = c-b
     kQ2 = (cQ-bQ)/aQ; kQ3 = cQ/aQ

     alpha2 = pi-theta(2); alpha3 = pi+theta(1) ! alpha1 = 0.0_dp
     
     cscf(2) = dcos(alpha2); sncf(2) = dsin(alpha2)
     cscf(3) = dcos(alpha3); sncf(3) = dsin(alpha3)

     vecA(1) = -1.0_dp/bQ; vecA(2) =  1.0_dp/bQ; vecA(3) = 0.0_dp
     vecB(1) =  kQ2/bQ   ; vecB(2) = -kQ3/bQ   ; vecB(3) = 1.0_dp/aQ
     
     ah(1,1) = vecA(1); ah(2,1) = (kQ2*sncf(2) - cscf(2))/bQ; ah(3,1) = (kQ2*sncf(3) - cscf(3))/bQ
     ah(1,2) = vecA(2); ah(2,2) = (cscf(2) - kQ3*sncf(2))/bQ; ah(3,2) = (cscf(3) - kQ3*sncf(3))/bQ
     ah(1,3) =  0.0_dp; ah(2,3) = sncf(2)/aQ                ; ah(3,3) = sncf(3)/aQ

     bh(1,1) = -vecB(1); bh(2,1) = -(sncf(2) + kQ2*cscf(2))/bQ; bh(3,1) = -(sncf(3) + kQ2*cscf(3))/bQ
     bh(1,2) = -vecB(2); bh(2,2) =  (sncf(2) + kQ3*cscf(2))/bQ; bh(3,2) =  (sncf(3) + kQ3*cscf(3))/bQ
     bh(1,3) = -vecB(3); bh(2,3) = -cscf(2)/aQ                ; bh(3,3) = -cscf(3)/aQ
    
     loop0a: do k=1,mx_nd_elt
	intGamwv(k) = 0.0_dp
        loop0b: do j=1,mx_nd_elt
           intclN(j,k) = 0.0_dp; intclM(j,k) = 0.0_dp; intGN3tmp(j,k) = 0.0_dp; intA(j,k) = 0.0_dp
	   intOme(j,k) = 0.0_dp; intGam(j,k) = 0.0_dp
	   intGK1(j,k) = 0.0_dp; intGK2(j,k) = 0.0_dp;    intGK3(j,k) = 0.0_dp
	enddo loop0b
     enddo loop0a

     loop1a: do k=2,3
        loop1b: do j=1,mx_nd_elt
           intR(j,k) = 0.0_dp
	enddo loop1b
     enddo loop1a

     loop2a: do i=1,ng1 ! Loop over y
        y = xi1(i)
        xh = b+cmb*y; zh = a*y
	p11h = -(c11*xh + c12*zh); q1h = -(c21*xh + c22*zh); eth = -(c31*xh + c32*zh)
	p31h = p11h*cscf(3) + q1h*sncf(3); q3h = q1h*cscf(3) - p11h*sncf(3)

        rho1hs = xh*xh + zh*zh
        rho1h = dsqrt(rho1hs)

	if (dabs(q1h) < gm_eps) q1h = 0.0_dp
	if (dabs(q3h) < gm_eps) q3h = 0.0_dp

	q1hs = q1h*q1h; eths = eth*eth; q3hs = q3h*q3h
	
	ethx2 = 2.0_dp*eth
	ethx2s = ethx2*ethx2

	p11hrho1h = p11h*rho1h; p31hrho1h = p31h*rho1h
	hh1 = p11hrho1h*q1hs*ethx2s; hh3 = p31hrho1h*q3hs*ethx2s
	cr11 = q1hs*rho1hs - p11h*p11h*eths; cr31 = q3hs*rho1hs - p31h*p31h*eths
	
	q1heth = q1h*ethx2; q3heth = q3h*ethx2

        loop2b: do k=1,ng1 ! Loop over x
           x = xi1(k)
	   xww = x*wwg1(k,i)
	   
	   p11 = x*p11h; q(1) = x*q1h; p31 = x*p31h; et = x*eth; q(3) = x*q3h
	   p12 = bQ+p11; x3 = cQ+p11; z3 = aQ+q(1)
	   p22 = p12*cscf(2) + q(1)*sncf(2); q(2) = q(1)*cscf(2) - p12*sncf(2)
	   p23 = x3*cscf(2) + z3*sncf(2); p33 = x3*cscf(3) + z3*sncf(3)
	   
	   ets = et*et; p12s = p12*p12; p33s = p33*p33; qs(1) = q(1)*q(1); qs(2) = q(2)*q(2); qs(3) = q(3)*q(3)
	   
	   rh1s = p11*p11 + qs(1) + ets; rh2s = p12s + qs(1) + ets; rh3s = p33s + qs(3) + ets
	   rho(1) = dsqrt(rh1s); rho(2) = dsqrt(rh2s); rho(3) = dsqrt(rh3s)

	   rhowv(1) = rho(1)-rho(2); rhowv(2) = rho(2)-rho(3); rhowv(3) = rho(3)-rho(1)

	   psi(1) = shfv(1,k,i); psi(2) = shfv(2,k,i); psi(3) = shfv(3,k,i) ! psi(1) = 1.0_dp-x; psi(2) = x*(1.0_dp-y); psi(3) = x*y

           shc(2) = (kQ3*q(1) - p11)/bQ; shc(3) = -q(1)/aQ
	   shc(1) = 1.0_dp - (shc(2)+shc(3)) ! shc(1) = 1.0_dp + (p11 - kQ2*q(1))/bQ
	   
	   if ( dabs(shc(1)) < gm_eps ) then
	      shc(1) = 0.0_dp; q(2) = 0.0_dp
	   endif
	   
	   if ( dabs(shc(2)) < gm_eps ) then
	      shc(2) = 0.0_dp
	   elseif ( dabs(shc(2)-1.0_dp) < gm_eps ) then
	      shc(2) = 1.0_dp
	   endif
	   
	   if ( dabs(shc(3)) < gm_eps ) then
	      shc(3) = 0.0_dp
	   elseif ( dabs(shc(3)-1.0_dp) < gm_eps ) then
	      shc(3) = 1.0_dp
	   endif
	   
	   theta0 = pt_tria_tst(shc(1),shc(2),shc(3),theta,th_id) ! Point in triangle test

	   chi(1) = dlog( (p11+rho(1))/(p12+rho(2)) ); chi(2) = dlog( (p22+rho(2))/(p23+rho(3)) ) 
	   chi(3) = -dlog( (p31+rho(1))/(p33+rho(3)) )
	   
	   d(1) = qs(1) + ets; d(2) = qs(2) + ets; d(3) = qs(3) + ets; q2et = 2.0_dp*q(2)*et

	   p12rh2 = p12*rho(2); p22rh2 = p22*rho(2); p23rh3 = p23*rho(3); p33rh3 = p33*rho(3)
	   
	   cr12 = q1hs*rh2s-p12s*eths
	   zn1 = q1heth*(p12rh2*cr11 - p11hrho1h*cr12)
	   zd1 = cr11*cr12 + p12rh2*hh1

	   cr22 = qs(2)*rh2s-p22*p22*ets; cr23 = qs(2)*rh3s-p23*p23*ets
	   zn2 = q2et*( p23rh3*cr22 - p22rh2*cr23 )
	   zd2 = cr22*cr23 + q2et*q2et*p22rh2*p23rh3

	   cr33 = q3hs*rh3s-p33s*eths
	   zn3 = q3heth*(p31hrho1h*cr33 - p33rh3*cr31)
	   zd3 = cr31*cr33 + p33rh3*hh3

           gamma(1) = gammai(p11,p12,q1heth,cr11,cr12,zn1,zd1)
	   gamma(2) = gammai(p22,p23,q2et  ,cr22,cr23,zn2,zd2)
	   gamma(3) = gammai(p33,p31,q3heth,cr33,cr31,zn3,zd3)
	   
	   if ( et > 0.0_dp ) then
	      ThetGam = 0.5_dp*(gamma(1)+gamma(2)+gamma(3)) + theta0
	   else
	      ThetGam = 0.5_dp*(gamma(1)+gamma(2)+gamma(3)) - theta0
	   endif

	   etThetGam = et*ThetGam
	   chis =          sncf(2)*chi(2) + sncf(3)*chi(3)
	   chic = chi(1) + cscf(2)*chi(2) + cscf(3)*chi(3)

	   loop3: do j=1,mx_nd_elt
	      xwp(j) = xww*psi(j); dchi(j) = d(j)*chi(j); qrhowv(j) = q(j)*rhowv(j); qchi(j) = q(j)*chi(j)
	      etchi(j) = et*chi(j)
           enddo loop3

	   omega = qchi(1) + qchi(2) + qchi(3)
           
           loop4a: do kk=1,mx_nd_elt
	      intGamwv(kk) = intGamwv(kk) + xwp(kk)*etThetGam
              loop4b: do j=1,mx_nd_elt
                 intclN(j,kk) = intclN(j,kk) + xwp(j)*qrhowv(kk)
		 intclM(j,kk) = intclM(j,kk) + xwp(j)*dchi(kk)

		 intGN3tmp(j,kk) = intGN3tmp(j,kk) + xwp(j)*etchi(kk)
		      intA(j,kk) =      intA(j,kk) + xwp(j)*qchi(kk)
		  
		 xwpc = xwp(j)*shc(kk)
		 intOme(j,kk) = intOme(j,kk) + xwpc*omega
		 intGam(j,kk) = intGam(j,kk) + xwpc*etThetGam
		  
		 intGK1(j,kk) = intGK1(j,kk) + xwpc*chis
		 intGK2(j,kk) = intGK2(j,kk) - xwpc*chic
		 intGK3(j,kk) = intGK3(j,kk) + xwpc*ThetGam
	      enddo loop4b
           enddo loop4a
	   
           loop5a: do kk=2,3
              loop5b: do j=1,mx_nd_elt
		 intR(j,kk) =  intR(j,kk) + xwp(j)*rhowv(kk)
	      enddo loop5b
           enddo loop5a

        enddo loop2b ! End Loop over x
     enddo loop2a ! End Loop over y

     intD(1,1) = intA(1,1); intD(2,1) = intA(2,1); intD(3,1) = intA(3,1)
     loop6a: do k=2,3
        loop6b: do i=1,mx_nd_elt
	   intR(i,k) = sncf(k)*intR(i,k)
	   intD(i,k) = intR(i,k) + cscf(k)*intA(i,k)
	   intA(i,k) = sncf(k)*intA(i,k)
        enddo loop6b
     enddo loop6a

    call dgemm('N','N',mx_nd_elt,3,3,1.0_dp,intD,mx_nd_elt,ah,3,0.0_dp,intGN1,mx_nd_elt) ! intGN1 = matmul(intD,ah)

    intGN2(1,1) = intR(1,2)*bh(2,1) + intR(1,3)*bh(3,1) + intA(1,2)*ah(2,1) + intA(1,3)*ah(3,1)
    intGN2(2,1) = intR(2,2)*bh(2,1) + intR(2,3)*bh(3,1) + intA(2,2)*ah(2,1) + intA(2,3)*ah(3,1)
    intGN2(3,1) = intR(3,2)*bh(2,1) + intR(3,3)*bh(3,1) + intA(3,2)*ah(2,1) + intA(3,3)*ah(3,1)
    
    intGN2(1,2) = intR(1,2)*bh(2,2) + intR(1,3)*bh(3,2) + intA(1,2)*ah(2,2) + intA(1,3)*ah(3,2)
    intGN2(2,2) = intR(2,2)*bh(2,2) + intR(2,3)*bh(3,2) + intA(2,2)*ah(2,2) + intA(2,3)*ah(3,2)
    intGN2(3,2) = intR(3,2)*bh(2,2) + intR(3,3)*bh(3,2) + intA(3,2)*ah(2,2) + intA(3,3)*ah(3,2)
    
    intGN2(1,3) = intR(1,2)*bh(2,3) + intR(1,3)*bh(3,3) + intA(1,2)*ah(2,3) + intA(1,3)*ah(3,3)
    intGN2(2,3) = intR(2,2)*bh(2,3) + intR(2,3)*bh(3,3) + intA(2,2)*ah(2,3) + intA(2,3)*ah(3,3)
    intGN2(3,3) = intR(3,2)*bh(2,3) + intR(3,3)*bh(3,3) + intA(3,2)*ah(2,3) + intA(3,3)*ah(3,3)

    call dgemm('N','N',mx_nd_elt,3,mx_nd_elt,1.0_dp,intGN3tmp,mx_nd_elt,bh,3,0.0_dp,intGN3,mx_nd_elt) ! intGN3 = matmul(intGN3tmp,bh)

!*** int_f = matmul(intclN,ah) - matmul(intclM,bh)
     call dgemm('N','N',mx_nd_elt,3,3,1.0_dp,intclM,mx_nd_elt,bh,3, 0.0_dp,int_f,mx_nd_elt) ! int_f = matmul(intclM,bh)
     call dgemm('N','N',mx_nd_elt,3,3,1.0_dp,intclN,mx_nd_elt,ah,3,-1.0_dp,int_f,mx_nd_elt) ! int_f = matmul(intclN,ah) - int_f

     loop7a: do j=1,mx_nd_elt
	loop7b: do i=1,mx_nd_elt
	   int_f(i,j) = 0.5_dp*int_f(i,j) + intOme(i,j) - intGam(i,j)
	   intGN1(i,j) = intGN1(i,j) - intGamwv(i)*vecA(j)
	   intGN2(i,j) = intGN2(i,j) - intGamwv(i)*vecB(j)
	enddo loop7b
     enddo loop7a
     
     c13cf = c13*dlt; c23cf = c23*dlt
     
     loop8a: do i=1,mx_nd_elt
        loop8b: do k=1,mx_nd_elt
           int_f(k,i) =   dlt*int_f(k,i)
           int_p(k,i) =  -dlt*(intGN3(k,i)+intGK3(k,i))
	   int_r(k,i) = c13cf*(intGN1(k,i)+intGK1(k,i)) + c23cf*(intGN2(k,i)+intGK2(k,i)) - c33*int_p(k,i)
        enddo loop8b
     enddo loop8a

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE sing_vtx
!----------------------------------------------------------------------------------------------------------------------------------!


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE svesp(a,b,c,aQ,bQ,cQ,theta,QPTM,int_p,int_f,int_r)
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!**********************************  GALERKIN BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  **********************************!
!************************************  3-NODED TRIANGULAR ELEMENT: SEMI-ANALYTIC INTEGRATION  *************************************!
!************************************************  PIECEWISE LINEAR APPROXIMATION  ************************************************!
!*******************************  EXact Inner integral with linear distribution on a flat triangle  *******************************!
!*****************************  Singular integration for vertex-adjacent elements on the same plane  ******************************!
!**********************************************************************************************************************************!

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

 
USE KINDS
USE PARAMS,   ONLY: pi,f_eps  ! pi = 3.1415926535897932, f_eps == Tolerance on the argument of a function
USE SRF_GEOM, ONLY: mx_nd_elt ! mx_nd_elt == Maximum number of nodes per element
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: wwg1      ! wwg1(k,i) = wg1(i)*wg1(k), where wg1(k) is the k-th Gauss-Legendre weight factor corresponding to xi1(k)


IMPLICIT NONE

 real   (kind=dp), intent(in ) :: a,b,c    ! Geometric parameters of element P: b = base, a = height,
                                           ! c = relative position of the 3rd vertex of element P
 real   (kind=dp), intent(in ) :: aQ,bQ,cQ ! Geometric parameters of element Q: bQ = base, aQ = height, 
                                           ! cQ = relative position of the 3rd vertex of element Q
 real   (kind=dp), intent(in ) :: theta(3) ! theta(i) == Angle at the i-th vertex of element Q
 real   (kind=dp), intent(in ) :: QPTM(3,3) ! Transition matrix from element Q to element P
 real   (kind=dp), intent(out) :: int_p(mx_nd_elt,mx_nd_elt) ! int_p == Singular contribution to potential influence matrix H
 real   (kind=dp), intent(out) :: int_f(mx_nd_elt,mx_nd_elt) ! int_f == Singular contribution to flux influence matrix G
 real   (kind=dp), intent(out) :: int_r(mx_nd_elt,mx_nd_elt) ! int_r == Singular contribution to potential influence matrix H: Reverse kernel

 integer(kind=k9) :: k,kk,i,j
 real   (kind=dp) :: kQ2,kQ3 ! kQ2 == Slope of Edge2 of element Q, kQ3 == Slope of Edge3 of element Q
 real   (kind=dp) :: c11,c21,c12,c22,p11,p11h,q1h,p12,p22,p23,p31,p33,x3,z3,cmb,xh,zh,p31h,q3h
 real   (kind=dp) :: dlt,alpha2,alpha3,x,y,xww,omega,z1,z1s,z2,z2s,ch33,ch31,chi(3),rhowv(3),qrhowv(3)
 real   (kind=dp) :: vecA(3),vecB(3),sncf(2:3),cscf(2:3),ah(3,3),bh(3,3),dchi(3),q(3),qs(3),rho(3)
 real   (kind=dp) :: psi(mx_nd_elt),shc(mx_nd_elt),xwp(mx_nd_elt)
 real   (kind=dp) :: intclN(mx_nd_elt,3),intclM(mx_nd_elt,3),intOme(mx_nd_elt,mx_nd_elt)



     dlt = a*b; cmb = c-b
     kQ2 = (cQ-bQ)/aQ; kQ3 = cQ/aQ

     c11 = QPTM(1,1); c21 = QPTM(2,1)
     c12 = QPTM(1,2); c22 = QPTM(2,2)

     alpha2 = pi-theta(2); alpha3 = pi+theta(1) ! alpha1 = 0.0_dp
     
     cscf(2) = dcos(alpha2); sncf(2) = dsin(alpha2)
     cscf(3) = dcos(alpha3); sncf(3) = dsin(alpha3)

     vecA(1) = -1.0_dp/bQ; vecA(2) =  1.0_dp/bQ; vecA(3) = 0.0_dp
     vecB(1) =  kQ2/bQ   ; vecB(2) = -kQ3/bQ   ; vecB(3) = 1.0_dp/aQ
     
     ah(1,1) = vecA(1); ah(2,1) = (kQ2*sncf(2) - cscf(2))/bQ; ah(3,1) = (kQ2*sncf(3) - cscf(3))/bQ
     ah(1,2) = vecA(2); ah(2,2) = (cscf(2) - kQ3*sncf(2))/bQ; ah(3,2) = (cscf(3) - kQ3*sncf(3))/bQ
     ah(1,3) =  0.0_dp; ah(2,3) = sncf(2)/aQ                ; ah(3,3) = sncf(3)/aQ

     bh(1,1) = -vecB(1); bh(2,1) = -(sncf(2) + kQ2*cscf(2))/bQ; bh(3,1) = -(sncf(3) + kQ2*cscf(3))/bQ
     bh(1,2) = -vecB(2); bh(2,2) =  (sncf(2) + kQ3*cscf(2))/bQ; bh(3,2) =  (sncf(3) + kQ3*cscf(3))/bQ
     bh(1,3) = -vecB(3); bh(2,3) = -cscf(2)/aQ                ; bh(3,3) = -cscf(3)/aQ
    
     loop0a: do k=1,mx_nd_elt
        loop0b: do j=1,mx_nd_elt
           intclN(j,k) = 0.0_dp; intclM(j,k) = 0.0_dp; intOme(j,k) = 0.0_dp
	enddo loop0b
     enddo loop0a

     loop1a: do i=1,ng1 ! Loop over y
        y = xi1(i)
        xh = b+cmb*y; zh = a*y
	p11h = -(c11*xh + c12*zh); q1h = -(c21*xh + c22*zh)
	p31h = p11h*cscf(3) + q1h*sncf(3); q3h = q1h*cscf(3) - p11h*sncf(3)

        loop1b: do k=1,ng1 ! Loop over x
           x = xi1(k)
	   xww = x*wwg1(k,i)
	   
	   p11 = x*p11h; q(1) = x*q1h; p31 = x*p31h; q(3) = x*q3h
	   p12 = bQ+p11; x3 = cQ+p11; z3 = aQ+q(1)
	   p22 = p12*cscf(2) + q(1)*sncf(2); q(2) = q(1)*cscf(2) - p12*sncf(2)
	   p23 = x3*cscf(2) + z3*sncf(2); p33 = x3*cscf(3) + z3*sncf(3)
	   
	   qs(1) = q(1)*q(1); qs(2) = q(2)*q(2); qs(3) = q(3)*q(3)
	   
	   rho(1) = dsqrt(p11*p11 + qs(1)); rho(2) = dsqrt(p12*p12 + qs(1)); rho(3) = dsqrt(p33*p33 + qs(3))
	   
	   rhowv(1) = rho(1)-rho(2); rhowv(2) = rho(2)-rho(3); rhowv(3) = rho(3)-rho(1)

	   psi(1) = shfv(1,k,i); psi(2) = shfv(2,k,i); psi(3) = shfv(3,k,i) ! psi(1) = 1.0_dp-x; psi(2) = x*(1.0_dp-y); psi(3) = x*y

           shc(2) = (kQ3*q(1) - p11)/bQ; shc(3) = -q(1)/aQ
	   shc(1) = 1.0_dp - (shc(2)+shc(3)) ! shc(1) = 1.0_dp + (p11 - kQ2*q(1))/bQ

	   chi(1) = dlog( (p11+rho(1))/(p12+rho(2)) ); chi(2) = dlog( (p22+rho(2))/(p23+rho(3)) ) 
	   ch31 = p31+rho(1); ch33 = p33+rho(3)
	   if ( (ch31 >= f_eps) .and. (ch33 >= f_eps) ) then
		chi(3) = -dlog(ch31/ch33)
	   else
		z1 = q3h/p31h; z2 = q(3)/p33
		z1s = z1*z1; z2s = z2*z2
		chi(3) = -dlog( (p33/p31)*( (1.0_dp-0.25_dp*z1s*(1.0_dp-0.5_dp*z1s))/(1.0_dp-0.25_dp*z2s*(1.0_dp-0.5_dp*z2s)) ) )
	   endif

	   loop2: do j=1,mx_nd_elt
	      xwp(j) = xww*psi(j); dchi(j) = qs(j)*chi(j); qrhowv(j) = q(j)*rhowv(j)
           enddo loop2

	   omega = q(1)*chi(1) + q(2)*chi(2) + q(3)*chi(3)
           
           loop3a: do kk=1,mx_nd_elt
              loop3b: do j=1,mx_nd_elt
                 intclN(j,kk) = intclN(j,kk) + xwp(j)*qrhowv(kk)
		 intclM(j,kk) = intclM(j,kk) + xwp(j)*dchi(kk)
		 intOme(j,kk) = intOme(j,kk) + xwp(j)*shc(kk)*omega
	      enddo loop3b
           enddo loop3a

         enddo loop1b ! End Loop over x
     enddo loop1a ! End Loop over y

!*** int_f = matmul(intclN,ah) - matmul(intclM,bh)
     call dgemm('N','N',mx_nd_elt,3,3,1.0_dp,intclM,mx_nd_elt,bh,3, 0.0_dp,int_f,mx_nd_elt) ! int_f = matmul(intclM,bh)
     call dgemm('N','N',mx_nd_elt,3,3,1.0_dp,intclN,mx_nd_elt,ah,3,-1.0_dp,int_f,mx_nd_elt) ! int_f = matmul(intclN,ah) - int_f

     loop4a: do i=1,mx_nd_elt
        loop4b: do k=1,mx_nd_elt
           int_f(k,i) = dlt*(0.5_dp*int_f(k,i) + intOme(k,i))
           int_p(k,i) = 0.0_dp
	   int_r(k,i) = 0.0_dp
        enddo loop4b
     enddo loop4a

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE svesp
!----------------------------------------------------------------------------------------------------------------------------------!
