!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE gbem_lap_iex_int_e(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  *******************************!
!**************************************************  Edge-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 edge of element P that is adjacent to element Q
			         ! PQmLocId(2) == Local index of the edge 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) :: PcoincidentSide,QcoincidentSide
 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,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 = bP = length of the coincident edge, aQ = height,
 			      ! cQ = relative position of the 3rd vertex of element Q in the local basis {e1Q,e2Q,e3Q}
 real   (kind=dp) :: QPTransitionMtrx(2,2)
 real   (kind=dp) :: vij(3,2),theta(3),alpha(3),alphaEltP(3),calpk,salpk,x



    PcoincidentSide = PQmLocId(1); QcoincidentSide = PQmLocId(2) ! Side "PcoincidentSide" of element P coincides
    								 ! with Side "QcoincidentSide" 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 edge of element Q specified by the nodes with local
!*** indices 1 and 2 respectively coincides with the edge of element Q that is adjacent to element P, i.e.,
!*** consider the permutation of node numbers of the inner element Q
     if (QcoincidentSide == 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(QcoincidentSide == 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 ! QcoincidentSide == 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 edge of element P specified by the nodes with local
!*** indices 1 and 2 respectively coincides with the edge of element P that is adjacent to element Q, i.e.,
!*** consider the permutation of node numbers of the outer element P
     if (PcoincidentSide == 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(PcoincidentSide == 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 ! PcoincidentSide == 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,2) = xeP(k,3) - xeP(k,2) ! x3-x2 <== Side 2 of element P
    enddo loop13
    
    cP = vij(1,2)*e1P(1) + vij(2,2)*e1P(2) + vij(3,2)*e1P(3)
    aP = vij(1,2)*e2P(1) + vij(2,2)*e2P(2) + vij(3,2)*e2P(3)


!*** C_ij == Transition matrix from {e1Q,e2Q,e3Q} to {e1P,e2P,e3P}
!*** Projection (Transformation) of e2P to coordinate system {e1Q,e2Q,e3Q} local to element Q
          QPTransitionMtrx(1,1) = e2P(1)*e2Q(1) + e2P(2)*e2Q(2) + e2P(3)*e2Q(3) ! C_22
	  QPTransitionMtrx(2,1) = 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 element Q
          QPTransitionMtrx(1,2) = e3P(1)*e2Q(1) + e3P(2)*e2Q(2) + e3P(3)*e2Q(3) ! C_23
	  QPTransitionMtrx(2,2) = e3P(1)*e3Q(1) + e3P(2)*e3Q(2) + e3P(3)*e3Q(3) ! C_33

     call sing_edg(aP,cP,aQ,bQ,cQ,theta,QPTransitionMtrx,int_p,int_f,int_r) ! Integration for edge-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_e
!----------------------------------------------------------------------------------------------------------------------------------!


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE sing_edg(a,c,aQ,b,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 edge-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: 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 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 = length of the coincident edge for elements P and Q,
 			                ! a = height, c = relative position of the 3rd vertex of element P
 real   (kind=dp), intent(in ) :: aQ,cQ ! Geometric parameters of element Q: b = length of the coincident edge for elements P and Q,
 			                ! 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(2,2) ! 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,i,ii,kk,th_id
 real   (kind=dp) :: dlt,a_rh2p2,a_rh3p2,a_rh2p2x3,a_rh3p2x3,c_rh2p2,bpc_rh3p2
 real   (kind=dp) :: ap2,ap3,ap4,bp2,bp3,bp4,cp2,cp3,cp4,rh2,rh3,rh2p2,rh2p3,rh2p4,rh2p6,rh3p2,rh3p3,rh3p4,rh3p6,cQmb
 real   (kind=dp) :: ln1,ln2,ln3,bc,bpc,bmc,bpcp2,bc_rh2,bc_rh2s,bbpc_rh3,bbpc_rh3s,bmrh2,bmrh3,ln2_rh2,ln3_rh3
 real   (kind=dp) :: kP2,kP3 ! kP2 == Slope of Edge2 of element P, kP3 == Slope of Edge3 of element P
 real   (kind=dp) :: kQ2,kQ3 ! kQ2 == Slope of Edge2 of element Q, kQ3 == Slope of Edge3 of element Q
 real   (kind=dp) :: c22,c32,c23,c33,c22p2,c32p2,c22c32x2,c22c32s,c22kQ2,c22kQ3,c22_aQ,p12rh2,p11rh1,dltHlf
 real   (kind=dp) :: Ichixx,Ichizz,Ichixz,Ichix,Ichiz,Ichi,Irhoz,Irhoxz,Irhozz,Ichixxz,Ichixzz,Ichizzz,chicR
 real   (kind=dp) :: x,y,xi,zt,p11,p12,p11s,p12s,et,xh,zh,eth,q1h,xhs,rho1h,rho1hs,rh1s,rho2h,rho2hs,q3hethx2,omega
 real   (kind=dp) :: ThetGam,etThetGam,cpbhlf,bhlf,cr11,cr12,xhrh1h,xhrh2h,xww,wpc,theta0,hh1,hh2,hh3,etx2,p31rh1,p33rh3
 real   (kind=dp) :: alpha2,alpha3,p22,p23,p31,p33,x3,z3,rh2s,rh3s,p31h,p31hs,q3h,q3hs,p22h,p22hs,q2h,q2hs,p22hrho2h,q2hethx2
 real   (kind=dp) :: d2h,d3h,zhs,eths,ets,zts,cr22,cr23,cr31,cr33,p33s,p31hrh1h,p22rh2,p23rh3,zn1,zd1,zn2,zd2,zn3,zd3
 real   (kind=dp) :: q(3),qs(2:3),d(2:3),rho(3),rhowv(2:3),chi(2:3),gamma(3),dchi(2:3),qchi(2:3),etchi(2:3),qrhowv(2:3),GN2cf(2:3)
 real   (kind=dp) :: vecA(3),vecB(3),sncf(2:3),cscf(2:3),ah(3,3),bh(3,3),qetx2(3),intclNbh(mx_nd_elt,2:3),intAh(mx_nd_elt,2:3)
 real   (kind=dp) :: psi(mx_nd_elt),shc(mx_nd_elt),xwp(mx_nd_elt),intGamwv(mx_nd_elt),intGamwvh(mx_nd_elt)
 real   (kind=dp) :: intclN(mx_nd_elt,3),intclM(mx_nd_elt,3),intclNh(mx_nd_elt,2:3),intclMh(mx_nd_elt,2:3)
 real   (kind=dp) :: intR(mx_nd_elt,2:3),intclA(mx_nd_elt,2:3),intRhoh(mx_nd_elt,2:3),intGN3tmp(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intGam(mx_nd_elt,mx_nd_elt),intGamh(mx_nd_elt,mx_nd_elt),intKh(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intOme(mx_nd_elt,mx_nd_elt),intOmeh(mx_nd_elt,mx_nd_elt),intGK2Rchk(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intGK2(mx_nd_elt,mx_nd_elt),intGN2(mx_nd_elt,mx_nd_elt),intGK2Rh(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intGK3(mx_nd_elt,mx_nd_elt),intGN3(mx_nd_elt,mx_nd_elt),intGK3h(mx_nd_elt,mx_nd_elt)

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



     c22 = QPTM(1,1); c32 = QPTM(2,1)
     c23 = QPTM(1,2); c33 = QPTM(2,2)
     
     if ( (dabs(c23) < gm_eps) .or. (dabs(c32) < gm_eps)) then
          call seesp(a,c,aQ,b,cQ,theta,c22,int_p,int_f,int_r) ! Integration for edge-adjacent elements on the same plane
	  return
     endif


    dlt = a*b

    ap2 = a*a;   bp2 = b*b;   cp2 = c*c
    ap3 = ap2*a; bp3 = bp2*b; cp3 = cp2*c
    ap4 = ap3*a; bp4 = bp3*b; cp4 = cp3*c
    
    bc = b*c; bpc = b+c; bmc = b-c
    bpcp2 = bpc*bpc

    rh2 = dsqrt(ap2+cp2); rh3 = dsqrt(ap2+bpcp2)
    rh2p2 = rh2*rh2;   rh3p2 = rh3*rh3
    rh2p3 = rh2p2*rh2; rh3p3 = rh3p2*rh3
    rh2p4 = rh2p3*rh2; rh3p4 = rh3p3*rh3
    rh2p6 = rh2p4*rh2p2; rh3p6 = rh3p4*rh3p2

    bc_rh2 = bc/rh2; bbpc_rh3 = (bp2+bc)/rh3
    bc_rh2s = bc_rh2/rh2; bbpc_rh3s = bbpc_rh3/rh3
    
    ln1 = dlog( (rh2+c)/(rh3+bpc) )
    ln2 = dlog( (b + bc_rh2)/(rh2 + rh3 + bc_rh2) )
    ln3 = dlog( (b - bbpc_rh3)/(rh2 + rh3 - bbpc_rh3) )
    
    a_rh2p2 = ap2/rh2p2; a_rh3p2 = ap2/rh3p2
    a_rh2p2x3 = 3.0_dp*a_rh2p2; a_rh3p2x3 = 3.0_dp*a_rh3p2
    bmrh2 = b-rh2; bmrh3 = b-rh3
    ln2_rh2 = ln2/rh2; ln3_rh3 = ln3/rh3
    c_rh2p2 = cp2/rh2p2; bpc_rh3p2 = bpcp2/rh3p2



     Irhoz = ap2*b*( bp3*( (bpcp2*bpcp2-ap2*(ap2+rh3p2))/rh3p6 + (ap2*(ap2+rh2p2)-cp4)/rh2p6 ) + &
             rh2*(2.0_dp+b*(b*(a_rh3p2x3-2.0_dp)-c)/rh3p2) - rh3*(2.0_dp+b*(b*a_rh2p2x3-bmc)/rh2p2) - &
             bp2*( a_rh2p2x3*bc_rh2s*ln2_rh2 + a_rh3p2x3*bbpc_rh3s*ln3_rh3 ) )/24.0_dp

     Irhoxz = ap2*b*( bp4*((5.0_dp*a_rh2p2*(a_rh2p2x3-4.0_dp)+3.0_dp)/rh2p2 +(5.0_dp*a_rh3p2*(a_rh3p2x3-1.0_dp)-2.0_dp)/rh3p2)-&
              rh2*(4.0_dp*b-6.0_dp*c+b*( 5.0_dp*ap2*b*( b*(a_rh3p2x3-2.0_dp)-c )/rh3p2-2.0_dp*(ap2+bc+bp2+bp2) )/rh3p2)-&
              rh3*(6.0_dp*c+b*( 5.0_dp*ap2*b*( c+b*(a_rh2p2x3-4.0_dp) )/rh2p2-ap2-ap2+3.0_dp*b*bmc )/rh2p2) + &
              15.0_dp*ap2*bp4*(cp3*ln2_rh2/rh2p6 + ap2*bpc*ln3_rh3/rh3p6) )/120.0_dp

     Irhozz = ap3*b*( bp4*bpc*(bpcp2+bpcp2-13.0_dp*ap2)/rh3p6 + bp4*c*(cp2+cp2-13.0_dp*ap2)/rh2p6 + &
              rh2*(6.0_dp+b*( b*( ap2*(15.0_dp*bbpc_rh3s+5.0_dp)-2.0_dp*(bp2+bc) )/rh3p2 -2.0_dp*(b+b+c))/rh3p2) - &
              rh3*(6.0_dp-b*( b*( ap2*(15.0_dp*bc_rh2s-5.0_dp)-bc-bc )/rh2p2 +bmc+bmc )/rh2p2) - &
              bp4*(a_rh2p2x3*(5.0_dp*a_rh2p2-4.0_dp)*ln2_rh2/rh2p2 - a_rh3p2x3*(5.0_dp*a_rh3p2-4.0_dp)*ln3_rh3/rh3p2) )/120.0_dp

     Ichixxz = ap2*b*( bp4*((a_rh2p2*(15.0_dp*a_rh2p2-32.0_dp)+19.0_dp)/rh2p2+(a_rh3p2*(15.0_dp*a_rh3p2-2.0_dp)-1.0_dp)/rh3p2)-&
               b*rh2*(2.0_dp+( a_rh3p2*(bp2*(15.0_dp*a_rh3p2-7.0_dp)-5.0_dp*bc)-ap2-ap2-4.0_dp*bp2-3.0_dp*bc )/rh3p2) - &
               b*rh3*(2.0_dp+( a_rh2p2*(bp2*(15.0_dp*a_rh2p2-32.0_dp)+5.0_dp*bc)-ap2-ap2+19.0_dp*bp2-7.0_dp*bc )/rh2p2) + &
               2.0_dp*(bmc*bmc+cp2+cp2)*ln1 + bp4*( 3.0_dp*cp3*(5.0_dp*a_rh2p2-4.0_dp)*ln2_rh2/rh2p4 + &
               bpc*(a_rh3p2*(15.0_dp*a_rh3p2+3.0_dp)+2.0_dp)*ln3_rh3/rh3p2 ) )/120.0_dp

     Ichixzz = ap3*b*( bp4*( c*(14.0_dp-15.0_dp*a_rh2p2)/rh2p4 - bpc*(1.0_dp+15.0_dp*a_rh3p2)/rh3p4 ) + &
               b*rh2*( b*(b*bpc*(15.0_dp*a_rh3p2+1.0_dp)+5.0_dp*ap2)/rh3p2-3.0_dp*b-c-c)/rh3p2 + &
               b*rh3*( b*( bc*(15.0_dp*a_rh2p2-14.0_dp)-5.0_dp*ap2)/rh2p2+6.0_dp*b-c-c )/rh2p2 - (2.0_dp*b-6.0_dp*c)*ln1 - &
               bp4*( (a_rh2p2*(15.0_dp*a_rh2p2-24.0_dp)+8.0_dp)*ln2_rh2/rh2p2 - &
               (a_rh3p2*(15.0_dp*a_rh3p2-9.0_dp)-2.0_dp)*ln3_rh3/rh3p2) )/120.0_dp

     Ichizzz = ap4*b*( bp4*( (11.0_dp-15.0_dp*a_rh3p2 - bpc*(15.0_dp*a_rh3p2-6.0_dp)*ln3_rh3)/rh3p4 + &
               (11.0_dp-15.0_dp*a_rh2p2 + c*(15.0_dp*a_rh2p2-6.0_dp)*ln2_rh2)/rh2p4  ) + 6.0_dp*ln1 + &
               b*rh2*( ( bp2*(15.0_dp*a_rh3p2-16.0_dp)-5.0_dp*bc )/rh3p2 - 2.0_dp )/rh3p2 + &
               b*rh3*( ( bp2*(15.0_dp*a_rh2p2-11.0_dp)+5.0_dp*bc )/rh2p2 - 2.0_dp )/rh2p2 )/120.0_dp

!Ichizz/b
     Ichizz = a*( bp2*( a_rh3p2x3*bbpc_rh3s - a_rh2p2x3*bc_rh2s ) - b*( a_rh3p2*(rh2+3.0_dp*rh2*bbpc_rh3s) + &
              a_rh2p2*(rh3-3.0_dp*rh3*bc_rh2s) ) + 2.0_dp*ap2*ln1 - bp3*( a_rh2p2*(a_rh2p2-2.0_dp*c_rh2p2)*ln2_rh2 + &
              a_rh3p2*(a_rh3p2-2.0_dp*bpc_rh3p2)*ln3_rh3 ) )/24.0_dp

!Ichixz/b
     Ichixz = ( b*(rh3*a_rh2p2*(4.0_dp*b-c-b*a_rh2p2x3)-rh2*a_rh3p2*(bpc-b*a_rh3p2x3)) - &
               bp3*(a_rh2p2*(1.0_dp+3.0_dp*c_rh2p2) + a_rh3p2x3*a_rh3p2) - ap2*(b-c-c)*ln1 + &
               bp2*(bc_rh2*a_rh2p2x3*ln2*c_rh2p2 - bbpc_rh3*a_rh3p2*(1.0_dp+a_rh3p2x3)*ln3) )/24.0_dp

!Ichixx/(b*b)
     Ichixx = a*( -b*( bc_rh2*(2.0_dp+3.0_dp*c_rh2p2)/rh2 + bbpc_rh3*(3.0_dp+a_rh3p2x3)/rh3 ) + &
             rh2*(a_rh3p2x3*bbpc_rh3 + bpc*(b+b-c)/rh3)/rh3 - rh3*(a_rh2p2x3*bc_rh2 - (5.0_dp*bc-cp2)/rh2)/rh2 + &
             2.0_dp*(b-c+cp2/b)*ln1 + bp2*( (6.0_dp+a_rh2p2*(a_rh2p2x3-7.0_dp))*ln2_rh2 + &
             (2.0_dp+a_rh3p2*(a_rh3p2x3+1.0_dp))*ln3_rh3 ) )/24.0_dp

!Ichiz/b
     Ichiz = ( b*( a_rh2p2*( bmrh3 - bc_rh2*ln2 ) + a_rh3p2*( bmrh2 + bbpc_rh3*ln3 ) ) + ap2*ln1 )/6.0_dp

!Ichix/b
     Ichix = a*(bc_rh2*bmrh3/rh2 + bbpc_rh3*bmrh2/rh3-(b-c)*ln1-bp2*((1.0_dp+c_rh2p2)*ln2_rh2+(1.0_dp+a_rh3p2)*ln3_rh3))/6.0_dp

     Ichi = 0.5_dp*dlt*( ln1 + b*(ln2_rh2 + ln3_rh3) )


     cQmb = cQ-b
     kQ2 = cQmb/aQ; kQ3 = cQ/aQ
     kP2 = c/a; kP3 = bpc/a

     c22p2 = c22*c22; c32p2 = c32*c32; c22c32x2 = 2.0_dp*c22*c32
     c22c32s = c22p2*c32p2; c22kQ2 = c22*kQ2; c22kQ3 = c22*kQ3; c22_aQ = c22/aQ
    
     intKh(1,1) = (kP2*c22kQ2*Ichizzz - Ichixxz + (kP2-c22kQ2)*Ichixzz)/bp2 - Ichixz + kP2*Ichizz
     intKh(2,1) = (Ichixxz - kP3*c22kQ2*Ichizzz - (kP3-c22kQ2)*Ichixzz)/bp2 + 2.0_dp*Ichixz - (kP3-c22kQ2)*Ichizz + b*Ichiz
     intKh(3,1) = (c22kQ2*Ichizzz + Ichixzz)/dlt + b*Ichizz/a
     intKh(1,2) = (Ichixxz - (kP2-c22kQ3)*Ichixzz - kP2*c22kQ3*Ichizzz)/bp2
     intKh(2,2) = (kP3*c22kQ3*Ichizzz - Ichixxz  + (kP3-c22kQ3)*Ichixzz)/bp2 - Ichixz - c22kQ3*Ichizz
     intKh(3,2) = -(c22kQ3*Ichizzz + Ichixzz)/dlt
     intKh(1,3) = c22_aQ*(kP2*Ichizzz - Ichixzz)/b
     intKh(2,3) = c22_aQ*( b*Ichizz + (Ichixzz - kP3*Ichizzz)/b )
     intKh(3,3) = c22_aQ*Ichizzz/a

     intclN(1,1) = -c22*(kP2*Irhozz - Irhoxz)/b
     intclN(2,1) = -c22*((Irhoxz - kP3*Irhozz)/b + Irhoz)
     intclN(3,1) = -c22*Irhozz/a

     intclM(1,1) = (kP2*Ichizzz - Ichixzz)/b
     intclM(2,1) = (Ichixzz - kP3*Ichizzz)/b + b*Ichizz
     intclM(3,1) = Ichizzz/a

    intGK2(1,1) =  Ichixx - c22kQ2*kP2*Ichizz/b - (kP2-c22kQ2)*Ichixz/b + Ichix - kP2*Ichiz
    intGK2(2,1) = -Ichixx + c22kQ2*kP3*Ichizz/b + (kP3-c22kQ2)*Ichixz/b - 2.0_dp*Ichix + (kP3-c22kQ2)*Ichiz - Ichi
    intGK2(3,1) = -( c22kQ2*Ichizz + Ichixz + b*Ichiz )/a
    intGK2(1,2) = -Ichixx + c22kQ3*kP2*Ichizz/b + (kP2-c22kQ3)*Ichixz/b
    intGK2(2,2) =  Ichixx - c22kQ3*kP3*Ichizz/b - (kP3-c22kQ3)*Ichixz/b + Ichix + c22kQ3*Ichiz
    intGK2(3,2) =  ( c22kQ3*Ichizz + Ichixz )/a
    intGK2(1,3) =  c22_aQ*(Ichixz - kP2*Ichizz)
    intGK2(2,3) =  c22_aQ*(kP3*Ichizz - Ichixz - b*Ichiz)
    intGK2(3,3) = -c22_aQ*b*Ichizz/a

    intGN3tmp(1,1) = -c32*(kP2*Ichizz-Ichixz); intGN3tmp(2,1) = -c32*(Ichixz-kP3*Ichizz+b*Ichiz); intGN3tmp(3,1) = -c32*b*Ichizz/a

      if (dabs(c22) < gm_eps ) c22 = 0.0_dp
      if (dabs(c32) < gm_eps ) c32 = 0.0_dp

     loop0a: do i=1,mx_nd_elt
        intGN2(i,1) = 0.0_dp; intGamwv(i) = 0.0_dp; intGamwvh(i) = 0.0_dp
        loop0b: do k=1,mx_nd_elt
              intGamh(k,i) = 0.0_dp;   intGam(k,i) = 0.0_dp; intGK3(k,i) = 0.0_dp; intGK3h(k,i) = 0.0_dp
	       intOme(k,i) = 0.0_dp;  intOmeh(k,i) = 0.0_dp
	   intGK2Rchk(k,i) = 0.0_dp; intGK2Rh(k,i) = 0.0_dp
        enddo loop0b
     enddo loop0a

     loop1a: do i=2,3
        loop1b: do k=1,mx_nd_elt
	    intclN(k,i) = 0.0_dp;  intclM(k,i) = 0.0_dp
	   intclNh(k,i) = 0.0_dp; intclMh(k,i) = 0.0_dp; intGN3tmp(k,i) = 0.0_dp; intclNbh(k,i) = 0.0_dp
	      intR(k,i) = 0.0_dp; intRhoh(k,i) = 0.0_dp;    intclA(k,i) = 0.0_dp;    intAh(k,i) = 0.0_dp
        enddo loop1b
     enddo loop1a

     bhlf = 0.5_dp*b
     cpbhlf = c+bhlf; 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/b; vecA(2) =  1.0_dp/b; vecA(3) = 0.0_dp
     vecB(1) =  kQ2/b   ; vecB(2) = -kQ3/b   ; vecB(3) = 1.0_dp/aQ
     
     ah(1,1) = vecA(1); ah(2,1) = (kQ2*sncf(2) - cscf(2))/b; ah(3,1) = (kQ2*sncf(3) - cscf(3))/b
     ah(1,2) = vecA(2); ah(2,2) = (cscf(2) - kQ3*sncf(2))/b; ah(3,2) = (cscf(3) - kQ3*sncf(3))/b
     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))/b; bh(3,1) = -(sncf(3) + kQ2*cscf(3))/b
     bh(1,2) = -vecB(2); bh(2,2) =  (sncf(2) + kQ3*cscf(2))/b; bh(3,2) =  (sncf(3) + kQ3*cscf(3))/b
     bh(1,3) = -vecB(3); bh(2,3) = -cscf(2)/aQ               ; bh(3,3) = -cscf(3)/aQ


     loop2a: do i=1,ng1 ! Loop over y  :: E'
        y = xi1(i)
	xh = c-cpbhlf*y; zh = a*(1.0_dp-y)
        eth = -c32*zh; q1h = -c22*zh
	p31h = xh*cscf(3) + q1h*sncf(3); q3h = q1h*cscf(3) - xh*sncf(3)
	xhs = xh*xh; zhs = zh*zh

        rho1hs = xhs + zhs
        rho1h = dsqrt(rho1hs)

	if (dabs(q3h) < gm_eps) q3h = 0.0_dp
	
	eths = eth*eth; p31hs = p31h*p31h; q3hs = q3h*q3h
	d3h = q3hs + eths
        
	xhrh1h = xh*rho1h; p31hrh1h = p31h*rho1h; q3hethx2 = 2.0_dp*q3h*eth
	cr11 = c22p2*rho1hs - c32p2*xhs; hh1 = 4.0_dp*c22c32s*xhrh1h
	cr31 = q3hs*rho1hs - p31hs*eths; hh3 = 4.0_dp*p31hrh1h*q3hs*eths
	
        loop2b: do k=1,ng1 ! Loop over x  :: E'
           x = xi1(k)
           xww = x*wwg1(k,i) ! xww = x*wg1(i)*wg1(k)
           xi = x*xh; zt = x*zh; q(1) = x*q1h; et = x*eth; p31 = x*p31h; q(3) = x*q3h ! p11 = xi
	   p12 = b+xi; x3 = cQ+xi; 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; zts = zt*zt; p33s = p33*p33; qs(2) = q(2)*q(2)

	   rh1s = xi*xi + zts; rh2s = p12s + zts; rh3s = p33s + q(3)*q(3) + ets
	   rho(1) = dsqrt(rh1s); rho(2) = dsqrt(rh2s); rho(3) = dsqrt(rh3s)

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

           shc(2) = -(xi+c22kQ3*zt)/b; shc(3) = c22_aQ*zt
	   shc(1) = 1.0_dp - (shc(2)+shc(3)) ! shc(1) = 1.0_dp + (xi+c22kQ2*zt)/b

	   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

	   rhowv(2) = rho(2)-rho(3); rhowv(3) = rho(3)-rho(1)
	   chi(2) = dlog( (p22+rho(2))/(p23+rho(3)) ); chi(3) = -dlog( (p31+rho(1))/(p33+rho(3)) )

	   d(2) = qs(2) + ets; d(3) = x*x*d3h; etx2 = 2.0_dp*et
	   
	   qetx2(1) = q(1)*etx2; qetx2(2) = q(2)*etx2
	   
	   cr12 = c22p2*rh2s - c32p2*p12s; p12rh2 = p12*rho(2)
	   zn1 = c22c32x2*(p12rh2*cr11 - xhrh1h*cr12); zd1 = cr11*cr12 + p12rh2*hh1

	   cr22 = qs(2)*rh2s - p22*p22*ets; cr23 = qs(2)*rh3s - p23*p23*ets; p22rh2 = p22*rho(2); p23rh3 = p23*rho(3)
	   zn2 = qetx2(2)*(p23rh3*cr22 - p22rh2*cr23); zd2 = cr22*cr23 + qetx2(2)*qetx2(2)*p22rh2*p23rh3
	   
	   cr33 = q3hs*rh3s - p33s*eths; p33rh3 = p33*rho(3)
	   zn3 = q3hethx2*(p31hrh1h*cr33 - p33rh3*cr31); zd3 = cr31*cr33 + p33rh3*hh3

	   gamma(1) = gammai(xi ,p12,qetx2(1),cr11,cr12,zn1,zd1)
	   gamma(2) = gammai(p22,p23,qetx2(2),cr22,cr23,zn2,zd2)
	   gamma(3) = gammai(p33,p31,q3hethx2,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

           xwp(1) = xww*psi(1)
	   loop3: do ii=2,3
              xwp(ii) = xww*psi(ii); dchi(ii) = d(ii)*chi(ii); qrhowv(ii) = q(ii)*rhowv(ii); qchi(ii) = q(ii)*chi(ii)
	      etchi(ii) = et*chi(ii)
           enddo loop3
	   
	   omega = qchi(2) + qchi(3)
	   chicR = cscf(2)*chi(2) + cscf(3)*chi(3)
           
           loop4a: do ii=1,mx_nd_elt
	      intGamwvh(ii) = intGamwvh(ii) + xwp(ii)*etThetGam
	      loop4b: do kk=1,mx_nd_elt
                 wpc = xwp(kk)*shc(ii)
                  intGamh(kk,ii) =  intGamh(kk,ii) + wpc*etThetGam
		  intGK3h(kk,ii) =  intGK3h(kk,ii) + wpc*ThetGam
		  intOmeh(kk,ii) =  intOmeh(kk,ii) + wpc*omega
		 intGK2Rh(kk,ii) = intGK2Rh(kk,ii) + wpc*chicR
              enddo loop4b
           enddo loop4a

           loop5a: do ii=2,3
              loop5b: do kk=1,mx_nd_elt
                  intclNh(kk,ii) =  intclNh(kk,ii) + xwp(kk)*qrhowv(ii)
		  intclMh(kk,ii) =  intclMh(kk,ii) + xwp(kk)*dchi(ii)
		 intclNbh(kk,ii) = intclNbh(kk,ii) + xwp(kk)*etchi(ii)
		  intRhoh(kk,ii) =  intRhoh(kk,ii) + xwp(kk)*rhowv(ii)
		    intAh(kk,ii) =    intAh(kk,ii) + xwp(kk)*qchi(ii)
              enddo loop5b
           enddo loop5a

        enddo loop2b ! End Loop over x  :: E'
     enddo loop2a ! End Loop over y  :: E'


     loop6a: do i=1,ng1 ! Loop over y  :: E"
        y = xi1(i)
        xh = bhlf+cpbhlf*y; zh = a*y
	eth = -c32*zh; q1h = -c22*zh
	p22h = xh*cscf(2) + q1h*sncf(2); q2h = q1h*cscf(2) - xh*sncf(2)
	xhs = xh*xh; zhs = zh*zh

        rho2hs = xhs + zhs
        rho2h = dsqrt(rho2hs)

	if (dabs(q2h) < gm_eps) q2h = 0.0_dp

	eths = eth*eth; p22hs = p22h*p22h; q2hs = q2h*q2h
	d2h = q2hs + eths

	xhrh2h = xh*rho2h; p22hrho2h = p22h*rho2h; q2hethx2 = 2.0_dp*q2h*eth
	cr12 = c22p2*rho2hs - c32p2*xhs; hh1 = 4.0_dp*c22c32s*xhrh2h
	cr22 = q2hs*rho2hs - p22hs*eths; hh2 = 4.0_dp*p22hrho2h*q2hs*eths
	
        loop6b: do k=1,ng1 ! Loop over x  :: E"
           x = xi1(k)
           xww = x*wwg1(k,i) ! xww = x*wg1(i)*wg1(k)
           xi = x*xh; zt = x*zh; q(1) = x*q1h; et = x*eth; p22 = x*p22h; q(2) = x*q2h ! p12 = xi
	   p11 = xi-b; x3 = cQmb+xi; z3 = aQ+q(1)
	   p23 = x3*cscf(2) + z3*sncf(2); p33 = x3*cscf(3) + z3*sncf(3)
	   p31 = p11*cscf(3) + q(1)*sncf(3); q(3) = q(1)*cscf(3) - p11*sncf(3)
	   ets = et*et; p11s = p11*p11; zts = zt*zt; p33s = p33*p33; qs(3) = q(3)*q(3)

	   rh1s = p11s + zts; rh2s = xi*xi + zts; rh3s = p33s + qs(3) + ets
	   rho(1) = dsqrt(rh1s); rho(2) = dsqrt(rh2s); rho(3) = dsqrt(rh3s)

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

           shc(1) = (xi+c22kQ2*zt)/b; shc(3) = c22_aQ*zt
	   shc(2) = 1.0_dp -(shc(1)+shc(3)) ! shc(2) = 1.0_dp - (xi+c22kQ3*zt)/b

	   if ( dabs(shc(2)) < gm_eps ) then
	      shc(2) = 0.0_dp; q(3) = 0.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
	   
	   if ( dabs(shc(1)) < gm_eps ) then
	      shc(1) = 0.0_dp
	   elseif ( dabs(shc(1)-1.0_dp) < gm_eps ) then
	      shc(1) = 1.0_dp
	   endif

	    theta0 = pt_tria_tst(shc(2),shc(3),shc(1),theta,th_id) ! Point in triangle test

	   rhowv(2) = rho(2)-rho(3); rhowv(3) = rho(3)-rho(1)
	   chi(2) = dlog( (p22+rho(2))/(p23+rho(3)) ); chi(3) = -dlog( (p31+rho(1))/(p33+rho(3)) )
	   
	   d(2) = x*x*d2h; d(3) = qs(3) + ets; etx2 = 2.0_dp*et
	   
	   qetx2(1) = q(1)*etx2; qetx2(3) = q(3)*etx2
	   
	   cr11 = c22p2*rh1s - c32p2*p11s; p11rh1 = p11*rho(1)
	   zn1 = c22c32x2*(xhrh2h*cr11 - p11rh1*cr12); zd1 = cr11*cr12 + p11rh1*hh1
	   
	   cr23 = q2hs*rh3s - p23*p23*eths; p23rh3 = p23*rho(3)
	   zn2 = q2hethx2*(p23rh3*cr22 - p22hrho2h*cr23); zd2 = cr22*cr23 + p23rh3*hh2
	   
	   cr33 = qs(3)*rh3s - p33s*ets; cr31 = qs(3)*rh1s - p31*p31*ets; p31rh1 = p31*rho(1); p33rh3 = p33*rho(3)
	   zn3 = qetx2(3)*(p31rh1*cr33 - p33rh3*cr31); zd3 = cr31*cr33 + qetx2(3)*qetx2(3)*p31rh1*p33rh3

	   gamma(1) = gammai(p11,xi ,qetx2(1),cr11,cr12,zn1,zd1)
	   gamma(2) = gammai(p22,p23,q2hethx2,cr22,cr23,zn2,zd2)
	   gamma(3) = gammai(p33,p31,qetx2(3),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

           xwp(1) = xww*psi(1)
	   loop7: do ii=2,3
              xwp(ii) = xww*psi(ii); dchi(ii) = d(ii)*chi(ii); qrhowv(ii) = q(ii)*rhowv(ii); qchi(ii) = q(ii)*chi(ii)
	      etchi(ii) = et*chi(ii)
           enddo loop7
	   
	   omega = qchi(2) + qchi(3)
	   chicR = cscf(2)*chi(2) + cscf(3)*chi(3)
	   
           loop8a: do ii=1,mx_nd_elt
	      intGamwv(ii) = intGamwv(ii) + xwp(ii)*etThetGam
	      loop8b: do kk=1,mx_nd_elt
                 wpc = xwp(kk)*shc(ii)
                     intGam(kk,ii) =     intGam(kk,ii) + wpc*etThetGam
		     intGK3(kk,ii) =     intGK3(kk,ii) + wpc*ThetGam
		     intOme(kk,ii) =     intOme(kk,ii) + wpc*omega
		 intGK2Rchk(kk,ii) = intGK2Rchk(kk,ii) + wpc*chicR
              enddo loop8b
           enddo loop8a
           
           loop9a: do ii=2,3
              loop9b: do kk=1,mx_nd_elt
                    intclN(kk,ii) =    intclN(kk,ii) + xwp(kk)*qrhowv(ii)
		    intclM(kk,ii) =    intclM(kk,ii) + xwp(kk)*dchi(ii)
		 intGN3tmp(kk,ii) = intGN3tmp(kk,ii) + xwp(kk)*etchi(ii)

		      intR(kk,ii) =      intR(kk,ii) + xwp(kk)*rhowv(ii)
		    intclA(kk,ii) =    intclA(kk,ii) + xwp(kk)*qchi(ii)
              enddo loop9b
           enddo loop9a
           
        enddo loop6b ! End Loop over x :: E"
     enddo loop6a ! End Loop over y  :: E"


     dltHlf = 0.5_dp*dlt
     GN2cf(2) = sncf(2)*dltHlf; GN2cf(3) = sncf(3)*dltHlf

    intGamwv(1) = dltHlf*(intGamwv(1) + intGamwvh(1))
    
    loop10a: do k=2,3
       intGamwv(k) = dltHlf*(intGamwv(k) + intGamwvh(k))
       loop10b: do i=1,mx_nd_elt
             intclN(i,k) = dltHlf*(   intclN(i,k) +  intclNh(i,k))
	     intclM(i,k) = dltHlf*(   intclM(i,k) +  intclMh(i,k))
	  intGN3tmp(i,k) = dltHlf*(intGN3tmp(i,k) + intclNbh(i,k))
	  
	    intR(i,k) = GN2cf(k)*(  intR(i,k) + intRhoh(i,k))
	  intclA(i,k) = GN2cf(k)*(intclA(i,k) +   intAh(i,k))
       enddo loop10b
    enddo loop10a

     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

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

    loop11a: do k=1,mx_nd_elt
       loop11b: do i=1,mx_nd_elt
	  intGam(i,k) = dltHlf*(intGam(i,k) + intGamh(i,k))
	  intGK3(i,k) = dltHlf*(intGK3(i,k) + intGK3h(i,k))
	  intOme(i,k) = dltHlf*(intOme(i,k) + intOmeh(i,k)) - c22*intKh(i,k)
	  
	  intGK2(i,k) = intGK2(i,k) - dltHlf*(intGK2Rh(i,k) + intGK2Rchk(i,k))
	  intGN2(i,k) = intGN2(i,k) - intGamwv(i)*vecB(k)
       enddo loop11b
    enddo loop11a

    loop12a: do k=1,mx_nd_elt
       loop12b: do i=1,mx_nd_elt
	  int_f(i,k) = 0.5_dp*int_f(i,k) + intOme(i,k) - intGam(i,k)    ! Weakly-singular kernel ==> G
	  int_p(i,k) = -(intGN3(i,k) + intGK3(i,k))                     ! Singular kernel ==> H
	  int_r(i,k) = c23*(intGN2(i,k) + intGK2(i,k)) - c33*int_p(i,k) ! Reverse kernel ==> H
       enddo loop12b
    enddo loop12a

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE sing_edg
!----------------------------------------------------------------------------------------------------------------------------------!


!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE seesp(a,c,aQ,b,cQ,theta,c22,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 edge-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: 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 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 = length of the coincident edge for elements P and Q,
 			                ! a = height, c = relative position of the 3rd vertex of element P
 real   (kind=dp), intent(in ) :: aQ,cQ ! Geometric parameters of element Q: b = length of the coincident edge for elements P and Q,
 			                ! 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 ) :: c22 ! Diagonal component of the 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,i,ii,kk
 real   (kind=dp) :: dlt,a_rh2p2,a_rh3p2,a_rh2p2x3,a_rh3p2x3,c_rh2p2,bpc_rh3p2
 real   (kind=dp) :: ap2,ap3,ap4,bp2,bp3,bp4,cp2,cp3,cp4,rh2,rh3,rh2p2,rh2p3,rh2p4,rh2p6,rh3p2,rh3p3,rh3p4,rh3p6,cQmb
 real   (kind=dp) :: ln1,ln2,ln3,bc,bpc,bmc,bpcp2,bc_rh2,bc_rh2s,bbpc_rh3,bbpc_rh3s,bmrh2,bmrh3,ln2_rh2,ln3_rh3
 real   (kind=dp) :: kP2,kP3 ! kP2 == Slope of Edge2 of element P, kP3 == Slope of Edge3 of element P
 real   (kind=dp) :: kQ2,kQ3 ! kQ2 == Slope of Edge2 of element Q, kQ3 == Slope of Edge3 of element Q
 real   (kind=dp) :: c22kQ2,c22kQ3,c22_aQ,dltHlf,x,y,xi,zt,xh,zh,q1h,cpbhlf,bhlf,qs(2:3)
 real   (kind=dp) :: Ichizz,Ichixz,Ichiz,Irhoz,Irhoxz,Irhozz,Ichixxz,Ichixzz,Ichizzz,xww,d2h,d3h,zts,omega
 real   (kind=dp) :: alpha2,alpha3,p11,p12,p22,p23,p31,p33,x3,z3,p31h,q3h,p22h,q2h,ch33,ch31,z1,z1s,z2,z2s,q(3)
 real   (kind=dp) :: vecA(3),vecB(3),sncf(2:3),cscf(2:3),ah(3,3),bh(3,3),rho(3),rhowv(2:3),chi(2:3),dchi(2:3),qrhowv(2:3)
 real   (kind=dp) :: psi(mx_nd_elt),shc(mx_nd_elt),xwp(mx_nd_elt),intKh(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intOme(mx_nd_elt,mx_nd_elt),intOmeh(mx_nd_elt,mx_nd_elt)
 real   (kind=dp) :: intclN(mx_nd_elt,3),intclNh(mx_nd_elt,2:3),intclM(mx_nd_elt,3),intclMh(mx_nd_elt,2:3)



    dlt = a*b

    ap2 = a*a;   bp2 = b*b;   cp2 = c*c
    ap3 = ap2*a; bp3 = bp2*b; cp3 = cp2*c
    ap4 = ap3*a; bp4 = bp3*b; cp4 = cp3*c
    
    bc = b*c; bpc = b+c; bmc = b-c
    bpcp2 = bpc*bpc

    rh2 = dsqrt(ap2+cp2); rh3 = dsqrt(ap2+bpcp2)
    rh2p2 = rh2*rh2;   rh3p2 = rh3*rh3
    rh2p3 = rh2p2*rh2; rh3p3 = rh3p2*rh3
    rh2p4 = rh2p3*rh2; rh3p4 = rh3p3*rh3
    rh2p6 = rh2p4*rh2p2; rh3p6 = rh3p4*rh3p2

    bc_rh2 = bc/rh2; bbpc_rh3 = (bp2+bc)/rh3
    bc_rh2s = bc_rh2/rh2; bbpc_rh3s = bbpc_rh3/rh3
    
    ln1 = dlog( (rh2+c)/(rh3+bpc) )
    ln2 = dlog( (b + bc_rh2)/(rh2 + rh3 + bc_rh2) )
    ln3 = dlog( (b - bbpc_rh3)/(rh2 + rh3 - bbpc_rh3) )
    
    a_rh2p2 = ap2/rh2p2; a_rh3p2 = ap2/rh3p2
    a_rh2p2x3 = 3.0_dp*a_rh2p2; a_rh3p2x3 = 3.0_dp*a_rh3p2
    bmrh2 = b-rh2; bmrh3 = b-rh3
    ln2_rh2 = ln2/rh2; ln3_rh3 = ln3/rh3
    c_rh2p2 = cp2/rh2p2; bpc_rh3p2 = bpcp2/rh3p2



     Irhoz = ap2*b*( bp3*( (bpcp2*bpcp2-ap2*(ap2+rh3p2))/rh3p6 + (ap2*(ap2+rh2p2)-cp4)/rh2p6 ) + &
             rh2*(2.0_dp+b*(b*(a_rh3p2x3-2.0_dp)-c)/rh3p2) - rh3*(2.0_dp+b*(b*a_rh2p2x3-bmc)/rh2p2) - &
             bp2*( a_rh2p2x3*bc_rh2s*ln2_rh2 + a_rh3p2x3*bbpc_rh3s*ln3_rh3 ) )/24.0_dp

     Irhoxz = ap2*b*( bp4*((5.0_dp*a_rh2p2*(a_rh2p2x3-4.0_dp)+3.0_dp)/rh2p2 +(5.0_dp*a_rh3p2*(a_rh3p2x3-1.0_dp)-2.0_dp)/rh3p2)-&
              rh2*(4.0_dp*b-6.0_dp*c+b*( 5.0_dp*ap2*b*( b*(a_rh3p2x3-2.0_dp)-c )/rh3p2-2.0_dp*(ap2+bc+bp2+bp2) )/rh3p2)-&
              rh3*(6.0_dp*c+b*( 5.0_dp*ap2*b*( c+b*(a_rh2p2x3-4.0_dp) )/rh2p2-ap2-ap2+3.0_dp*b*bmc )/rh2p2) + &
              15.0_dp*ap2*bp4*(cp3*ln2_rh2/rh2p6 + ap2*bpc*ln3_rh3/rh3p6) )/120.0_dp

     Irhozz = ap3*b*( bp4*bpc*(bpcp2+bpcp2-13.0_dp*ap2)/rh3p6 + bp4*c*(cp2+cp2-13.0_dp*ap2)/rh2p6 + &
              rh2*(6.0_dp+b*( b*( ap2*(15.0_dp*bbpc_rh3s+5.0_dp)-2.0_dp*(bp2+bc) )/rh3p2 -2.0_dp*(b+b+c))/rh3p2) - &
              rh3*(6.0_dp-b*( b*( ap2*(15.0_dp*bc_rh2s-5.0_dp)-bc-bc )/rh2p2 +bmc+bmc )/rh2p2) - &
              bp4*(a_rh2p2x3*(5.0_dp*a_rh2p2-4.0_dp)*ln2_rh2/rh2p2 - a_rh3p2x3*(5.0_dp*a_rh3p2-4.0_dp)*ln3_rh3/rh3p2) )/120.0_dp

     Ichixxz = ap2*b*( bp4*((a_rh2p2*(15.0_dp*a_rh2p2-32.0_dp)+19.0_dp)/rh2p2+(a_rh3p2*(15.0_dp*a_rh3p2-2.0_dp)-1.0_dp)/rh3p2)-&
               b*rh2*(2.0_dp+( a_rh3p2*(bp2*(15.0_dp*a_rh3p2-7.0_dp)-5.0_dp*bc)-ap2-ap2-4.0_dp*bp2-3.0_dp*bc )/rh3p2) - &
               b*rh3*(2.0_dp+( a_rh2p2*(bp2*(15.0_dp*a_rh2p2-32.0_dp)+5.0_dp*bc)-ap2-ap2+19.0_dp*bp2-7.0_dp*bc )/rh2p2) + &
               2.0_dp*(bmc*bmc+cp2+cp2)*ln1 + bp4*( 3.0_dp*cp3*(5.0_dp*a_rh2p2-4.0_dp)*ln2_rh2/rh2p4 + &
               bpc*(a_rh3p2*(15.0_dp*a_rh3p2+3.0_dp)+2.0_dp)*ln3_rh3/rh3p2 ) )/120.0_dp

     Ichixzz = ap3*b*( bp4*( c*(14.0_dp-15.0_dp*a_rh2p2)/rh2p4 - bpc*(1.0_dp+15.0_dp*a_rh3p2)/rh3p4 ) + &
               b*rh2*( b*(b*bpc*(15.0_dp*a_rh3p2+1.0_dp)+5.0_dp*ap2)/rh3p2-3.0_dp*b-c-c)/rh3p2 + &
               b*rh3*( b*( bc*(15.0_dp*a_rh2p2-14.0_dp)-5.0_dp*ap2)/rh2p2+6.0_dp*b-c-c )/rh2p2 - (2.0_dp*b-6.0_dp*c)*ln1 - &
               bp4*( (a_rh2p2*(15.0_dp*a_rh2p2-24.0_dp)+8.0_dp)*ln2_rh2/rh2p2 - &
               (a_rh3p2*(15.0_dp*a_rh3p2-9.0_dp)-2.0_dp)*ln3_rh3/rh3p2) )/120.0_dp

     Ichizzz = ap4*b*( bp4*( (11.0_dp-15.0_dp*a_rh3p2 - bpc*(15.0_dp*a_rh3p2-6.0_dp)*ln3_rh3)/rh3p4 + &
               (11.0_dp-15.0_dp*a_rh2p2 + c*(15.0_dp*a_rh2p2-6.0_dp)*ln2_rh2)/rh2p4  ) + 6.0_dp*ln1 + &
               b*rh2*( ( bp2*(15.0_dp*a_rh3p2-16.0_dp)-5.0_dp*bc )/rh3p2 - 2.0_dp )/rh3p2 + &
               b*rh3*( ( bp2*(15.0_dp*a_rh2p2-11.0_dp)+5.0_dp*bc )/rh2p2 - 2.0_dp )/rh2p2 )/120.0_dp

!Ichizz/b
     Ichizz = a*( bp2*( a_rh3p2x3*bbpc_rh3s - a_rh2p2x3*bc_rh2s ) - b*( a_rh3p2*(rh2+3.0_dp*rh2*bbpc_rh3s) + &
              a_rh2p2*(rh3-3.0_dp*rh3*bc_rh2s) ) + 2.0_dp*ap2*ln1 - bp3*( a_rh2p2*(a_rh2p2-2.0_dp*c_rh2p2)*ln2_rh2 + &
              a_rh3p2*(a_rh3p2-2.0_dp*bpc_rh3p2)*ln3_rh3 ) )/24.0_dp

!Ichixz/b
     Ichixz = ( b*(rh3*a_rh2p2*(4.0_dp*b-c-b*a_rh2p2x3)-rh2*a_rh3p2*(bpc-b*a_rh3p2x3)) - &
               bp3*(a_rh2p2*(1.0_dp+3.0_dp*c_rh2p2) + a_rh3p2x3*a_rh3p2) - ap2*(b-c-c)*ln1 + &
               bp2*(bc_rh2*a_rh2p2x3*ln2*c_rh2p2 - bbpc_rh3*a_rh3p2*(1.0_dp+a_rh3p2x3)*ln3) )/24.0_dp

!Ichiz/b
     Ichiz = ( b*( a_rh2p2*( bmrh3 - bc_rh2*ln2 ) + a_rh3p2*( bmrh2 + bbpc_rh3*ln3 ) ) + ap2*ln1 )/6.0_dp

     cQmb = cQ-b
     kQ2 = cQmb/aQ; kQ3 = cQ/aQ
     kP2 = c/a; kP3 = bpc/a
     
     c22kQ2 = c22*kQ2; c22kQ3 = c22*kQ3; c22_aQ = c22/aQ
    
     intKh(1,1) = (kP2*c22kQ2*Ichizzz - Ichixxz + (kP2-c22kQ2)*Ichixzz)/bp2 - Ichixz + kP2*Ichizz
     intKh(2,1) = (Ichixxz - kP3*c22kQ2*Ichizzz - (kP3-c22kQ2)*Ichixzz)/bp2 + 2.0_dp*Ichixz - (kP3-c22kQ2)*Ichizz + b*Ichiz
     intKh(3,1) = (c22kQ2*Ichizzz + Ichixzz)/dlt + b*Ichizz/a
     
     intKh(1,2) = (Ichixxz - (kP2-c22kQ3)*Ichixzz - kP2*c22kQ3*Ichizzz)/bp2
     intKh(2,2) = (kP3*c22kQ3*Ichizzz - Ichixxz  + (kP3-c22kQ3)*Ichixzz)/bp2 - Ichixz - c22kQ3*Ichizz
     intKh(3,2) = -(c22kQ3*Ichizzz + Ichixzz)/dlt
     
     intKh(1,3) = c22_aQ*(kP2*Ichizzz - Ichixzz)/b
     intKh(2,3) = c22_aQ*( b*Ichizz + (Ichixzz - kP3*Ichizzz)/b )
     intKh(3,3) = c22_aQ*Ichizzz/a


     intclN(1,1) = -c22*(kP2*Irhozz - Irhoxz)/b
     intclN(2,1) = -c22*((Irhoxz - kP3*Irhozz)/b + Irhoz)
     intclN(3,1) = -c22*Irhozz/a

     intclM(1,1) = (kP2*Ichizzz - Ichixzz)/b
     intclM(2,1) = (Ichixzz - kP3*Ichizzz)/b + b*Ichizz
     intclM(3,1) = Ichizzz/a


     loop0a: do i=1,mx_nd_elt
        loop0b: do k=1,mx_nd_elt
	   intOme(k,i) = 0.0_dp; intOmeh(k,i) = 0.0_dp
        enddo loop0b
     enddo loop0a

     loop1a: do i=2,3
        loop1b: do k=1,mx_nd_elt
	   intclN(k,i) = 0.0_dp; intclM(k,i) = 0.0_dp; intclNh(k,i) = 0.0_dp; intclMh(k,i) = 0.0_dp
        enddo loop1b
     enddo loop1a

     bhlf = 0.5_dp*b
     cpbhlf = c+bhlf; 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/b; vecA(2) =  1.0_dp/b; vecA(3) = 0.0_dp
     vecB(1) =  kQ2/b   ; vecB(2) = -kQ3/b   ; vecB(3) = 1.0_dp/aQ
     
     ah(1,1) = vecA(1); ah(2,1) = (kQ2*sncf(2) - cscf(2))/b; ah(3,1) = (kQ2*sncf(3) - cscf(3))/b
     ah(1,2) = vecA(2); ah(2,2) = (cscf(2) - kQ3*sncf(2))/b; ah(3,2) = (cscf(3) - kQ3*sncf(3))/b
     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))/b; bh(3,1) = -(sncf(3) + kQ2*cscf(3))/b
     bh(1,2) = -vecB(2); bh(2,2) =  (sncf(2) + kQ3*cscf(2))/b; bh(3,2) =  (sncf(3) + kQ3*cscf(3))/b
     bh(1,3) = -vecB(3); bh(2,3) = -cscf(2)/aQ               ; bh(3,3) = -cscf(3)/aQ

     loop2a: do i=1,ng1 ! Loop over y  :: E'
        y = xi1(i)
	xh = c-cpbhlf*y; zh = a*(1.0_dp-y)
        q1h = -c22*zh
	p31h = xh*cscf(3) + q1h*sncf(3); q3h = q1h*cscf(3) - xh*sncf(3)
        d3h = q3h*q3h
	
        loop2b: do k=1,ng1 ! Loop over x  :: E'
           x = xi1(k)
           xww = x*wwg1(k,i) ! xww = x*wg1(i)*wg1(k)
           xi = x*xh; zt = x*zh; q(1) = x*q1h; p31 = x*p31h; q(3) = x*q3h ! p11 = xi
	   p12 = b+xi; x3 = cQ+xi; 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)
	   zts = zt*zt; qs(2) = q(2)*q(2); qs(3) = x*x*d3h

	   rho(1) = dsqrt(xi*xi + zts); rho(2) = dsqrt(p12*p12 + zts); rho(3) = dsqrt(p33*p33 + q(3)*q(3))

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

           shc(2) = -(xi+c22kQ3*zt)/b; shc(3) = c22_aQ*zt
	   shc(1) = 1.0_dp - (shc(2)+shc(3)) ! shc(1) = 1.0_dp + (xi+c22kQ2*zt)/b

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

	   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
	   
           xwp(1) = xww*psi(1)
	   loop3: do ii=2,3
              xwp(ii) = xww*psi(ii); dchi(ii) = qs(ii)*chi(ii); qrhowv(ii) = q(ii)*rhowv(ii)
           enddo loop3
	   
	   omega = q(2)*chi(2) + q(3)*chi(3)
           
           loop4a: do ii=1,mx_nd_elt
	      loop4b: do kk=1,mx_nd_elt
		 intOmeh(kk,ii) = intOmeh(kk,ii) + xwp(kk)*shc(ii)*omega
              enddo loop4b
           enddo loop4a
           

           loop5a: do ii=2,3
              loop5b: do kk=1,mx_nd_elt
                 intclNh(kk,ii) = intclNh(kk,ii) + xwp(kk)*qrhowv(ii)
		 intclMh(kk,ii) = intclMh(kk,ii) + xwp(kk)*dchi(ii)
              enddo loop5b
           enddo loop5a

         enddo loop2b ! End Loop over x  :: E'
     enddo loop2a ! End Loop over y  :: E'


     loop6a: do i=1,ng1 ! Loop over y  :: E"
        y = xi1(i)
        xh = bhlf+cpbhlf*y; zh = a*y
	q1h = -c22*zh
	p22h = xh*cscf(2) + q1h*sncf(2); q2h = q1h*cscf(2) - xh*sncf(2)
        d2h = q2h*q2h

        loop6b: do k=1,ng1 ! Loop over x  :: E"
           x = xi1(k)
           xww = x*wwg1(k,i) ! xww = x*wg1(i)*wg1(k)
           xi = x*xh; zt = x*zh; q(1) = x*q1h; p22 = x*p22h; q(2) = x*q2h ! p12 = xi
	   p11 = xi-b; x3 = cQmb+xi; z3 = aQ+q(1)
	   p23 = x3*cscf(2) + z3*sncf(2); p33 = x3*cscf(3) + z3*sncf(3)
	   p31 = p11*cscf(3) + q(1)*sncf(3); q(3) = q(1)*cscf(3) - p11*sncf(3)
	   zts = zt*zt; qs(2) = x*x*d2h; qs(3) = q(3)*q(3)

	   rho(1) = dsqrt(p11*p11 + zts); rho(2) = dsqrt(xi*xi + zts); rho(3) = dsqrt(p33*p33 + qs(3))

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

           shc(1) = (xi+c22kQ2*zt)/b; shc(3) = c22_aQ*zt
	   shc(2) = 1.0_dp -(shc(1)+shc(3)) ! shc(2) = 1.0_dp - (xi+c22kQ3*zt)/b

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

	   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 = q(3)/p31; 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

           xwp(1) = xww*psi(1)
	   loop7: do ii=2,3
              xwp(ii) = xww*psi(ii); dchi(ii) = qs(ii)*chi(ii); qrhowv(ii) = q(ii)*rhowv(ii)
           enddo loop7
	   
	   omega = q(2)*chi(2) + q(3)*chi(3)
           
           loop8a: do ii=1,mx_nd_elt
	      loop8b: do kk=1,mx_nd_elt
		 intOme(kk,ii) = intOme(kk,ii) + xwp(kk)*shc(ii)*omega
              enddo loop8b
           enddo loop8a
           
           loop9a: do ii=2,3
              loop9b: do kk=1,mx_nd_elt
                 intclN(kk,ii) = intclN(kk,ii) + xwp(kk)*qrhowv(ii)
		 intclM(kk,ii) = intclM(kk,ii) + xwp(kk)*dchi(ii)
              enddo loop9b
           enddo loop9a
           
         enddo loop6b ! End Loop over x :: E"
     enddo loop6a ! End Loop over y  :: E"

    dltHlf = 0.5_dp*dlt

    loop10a: do k=2,3
       loop10b: do i=1,mx_nd_elt    ! Loop over all nodes
          intclN(i,k) = dltHlf*(intclN(i,k) +  intclNh(i,k))
	  intclM(i,k) = dltHlf*(intclM(i,k) +  intclMh(i,k))
       enddo loop10b
    enddo loop10a

!*** 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

    loop11a: do k=1,mx_nd_elt
       loop11b: do i=1,mx_nd_elt
	  intOme(i,k) = dltHlf*(intOme(i,k) + intOmeh(i,k)) - c22*intKh(i,k)
       enddo loop11b
    enddo loop11a

    loop12a: do k=1,mx_nd_elt
       loop12b: do i=1,mx_nd_elt
	  int_f(i,k) = 0.5_dp*int_f(i,k) + intOme(i,k) ! Weakly-singular kernel ==> G
	  int_p(i,k) = 0.0_dp                          ! Singular kernel ==> H
	  int_r(i,k) = 0.0_dp                          ! Reverse kernel ==> H
       enddo loop12b
    enddo loop12a

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE seesp
!----------------------------------------------------------------------------------------------------------------------------------!
