!----------------------------------------------------------------------------------------------------------------------------------!
SUBROUTINE cbem_lap_fld_eval(nip,ipts,fldvl)
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!********************************  COLLOCATION BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  *********************************!
!***************************************  3-NODED TRIANGULAR ELEMENT: ANALYTIC INTEGRATION  ***************************************!
!***********************************************  PIECEWISE CONSTANT APPROXIMATION  ***********************************************!
!********************************  EXact INTegration with Uniform Distribution on a flat triangle  ********************************!
!***********************************  Given an array of field points ipts(:,i), i=1,2,...,nip  ************************************!
!***********  Determine the potential at all field points ipts(:,i) due to boundary distribution of potential and flux  ***********!
!**********************************************************************************************************************************!

!*** Developer: Sylvain Nintcheu Fata
!*** Version:   V.1.3
!*** 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,fac       ! pi = 3.1415926535897932, fac == Factor of the Green's function: fac = 1/(4*pi)
USE PARAMS,   ONLY: gm_eps,f_eps ! gm_eps == Tolerance on the geometry
				 ! 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: nbelt,belt   ! nbelt == Total number of boundary elements
			         ! belt(k,elQ) == Global index of the k-th node on the boundary element elQ 
USE SRF_GEOM, ONLY: bnd          ! bnd(:,k) == Cartesian coordinates of the k-th boundary node
USE POTFLUX,  ONLY: phi, flx     ! phi == Vector containing boundary potentials
                                 ! flx == Vector containing boundary fluxes


IMPLICIT NONE

 integer(kind=k9), intent(in ) :: nip ! nip == Number of interior points
 real   (kind=dp), intent(in ) :: ipts(3,nip) ! ipts(:,i) == Cartesian coordinates of the i-th interior (or field) point
 real   (kind=dp), intent(out) :: fldvl(nip)  ! fldvl(i) == Potential at the i-th interior point

 integer(kind=k9) :: k,i,th_id,elQ     ! elQ == Global index of the current boundary element
 real   (kind=dp) :: e1(3),e2(3),e3(3) ! Orthonormal companion basis associated with element elQ
 real   (kind=dp) :: xeQ(3,mx_nd_elt)  ! xeQ(:,k) == Cartesian coordinates of the k-th vertex of the triangle elQ
 real   (kind=dp) :: aQ,bQ,cQ ! Geometric parameters of element elQ: bQ = base, aQ = height,
                              ! cQ = relative position of the 3rd node of element elQ
 real   (kind=dp) :: r1(3),xi,zt,eth,et,ets,q(3),qs(3),rho(3),chi(3),gamma(3),gam
 real   (kind=dp) :: vij(3,2),aQs,bmc,theta(3),alpha2,alpha3,Rh(3),Rhs(3),ch11,ch12,ch22,ch23,ch33,ch31
 real   (kind=dp) :: kQ3 ! kQ3 == Slope of Edge3 of element elQ
 real   (kind=dp) :: shc(mx_nd_elt),sncf2,sncf3,cscf2,cscf3,qetx2(3)
 real   (kind=dp) :: p11,p12,p22,p23,p33,p31,x3,z3,rh1s,rh2s,rh3s,p11s,p12s,p33s,p11rh1,p31rh1,omega
 real   (kind=dp) :: cr11,cr12,zn1,zd1,cr22,cr23,zn2,zd2,cr31,cr33,zn3,zd3,p12rh2,p22rh2,p23rh3,p33rh3,theta0,ThetGam
!*** Note: Below, the Projection of the collocation point ipts(:,i) means the Projection of the collocation point ipts(:,i) on
!*** Note: the plane of element elQ in the direction e3. e3 is the unit normal to element elQ

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



    loop0: do k=1,nip    ! Loop over all interior points
       fldvl(k) = 0.0_dp ! Initialize the potential fldvl(k) at all interior points
    enddo loop0

    loop1: do elQ=1,nbelt ! Loop over all boundary elements

       loop2a: do k=1,mx_nd_elt ! Loop over all vertices of element elQ
          loop2b: do i=1,3 ! Loop over all components
             xeQ(i,k) = bnd(i,belt(k,elQ)) ! xeQ(:,k) == Cartesian coordinates of the k-th vertex on the triangle elQ
	                                   ! belt(k,elQ) == Global index of the k-th node on the boundary element elQ
          enddo loop2b
       enddo loop2a

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

       call ortho_comp_basis(vij(:,1),vij(:,2),e1,e2,e3) ! Deternime the orthonormal companion basis associated with element elQ

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

       bmc = bQ-cQ; aQs = aQ*aQ

       theta(1) = dacos(cQ/dsqrt(cQ*cQ + aQs)); theta(2) = dacos(bmc/dsqrt(bmc*bmc + aQs)); theta(3) = pi - (theta(1)+theta(2))

       alpha2 = pi-theta(2); alpha3 = pi+theta(1) ! alpha1 = 0.0

!       kQ2 = -bmc/aQ;  kQ2 == Slope of Side 2 of element elQ
       kQ3 = cQ/aQ ! kQ3 == Slope of Side 3 of element elQ

       cscf2 = dcos(alpha2); sncf2 = dsin(alpha2); cscf3 = dcos(alpha3); sncf3 = dsin(alpha3)
     
       loop4: do i=1,nip ! Loop over all interior points

          loop5: do k=1,3 ! Loop over all components
	     r1(k) = ipts(k,i) - xeQ(k,1) ! r1 = ipts(:,i)-y1
          enddo loop5

           xi = r1(1)*e1(1) + r1(2)*e1(2) + r1(3)*e1(3)
           zt = r1(1)*e2(1) + r1(2)*e2(2) + r1(3)*e2(3)
          eth = r1(1)*e3(1) + r1(2)*e3(2) + r1(3)*e3(3)

           p11 = -xi; p12 = bQ-xi; q(1) = -zt; et = -eth

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

	   x3 = cQ+p11; z3 = aQ+q(1)
	   p22 = p12*cscf2 + q(1)*sncf2; p23 = x3*cscf2 + z3*sncf2; q(2) = q(1)*cscf2 - p12*sncf2
	   p31 = p11*cscf3 + q(1)*sncf3; p33 = x3*cscf3 + z3*sncf3; q(3) = q(1)*cscf3 - p11*sncf3

	   ets = et*et; p11s = p11*p11; p12s = p12*p12; p33s = p33*p33; qs(1) = q(1)*q(1); qs(2) = q(2)*q(2); qs(3) = q(3)*q(3)

	   Rhs(1) = p11s + qs(1); Rhs(2) = p12s + qs(1); Rhs(3) = p33s + qs(3) ! Rhs(3) = x3*x3 + z3*z3
	   Rh(1) = dsqrt(Rhs(1)); Rh(2) = dsqrt(Rhs(2)); Rh(3) = dsqrt(Rhs(3))
	   rh1s = Rhs(1) + ets; rh2s = Rhs(2) + ets; rh3s = Rhs(3) + ets
	   rho(1) = dsqrt(rh1s); rho(2) = dsqrt(rh2s); rho(3) = dsqrt(rh3s)

	   shc(3) = -q(1)/aQ; shc(2) = (kQ3*q(1) - p11)/bQ
	   shc(1) = 1.0_dp - (shc(3)+shc(2)) ! 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; q(3) = 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; q(1) = 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

	   if ( th_id == 4 ) then ! if the Projection of the collocation point ipts(:,i) is at vertex y1
	      Rh(1) = 0.0_dp
	      if (et == 0.0_dp) rho(1) = 0.0_dp ! ipts(:,i) = y1
	   elseif ( th_id == 5 ) then ! if the Projection of the collocation point ipts(:,i) is at vertex y2
	      Rh(2) = 0.0_dp
	      if (et == 0.0_dp) rho(2) = 0.0_dp ! ipts(:,i) = y2
	   elseif ( th_id == 6 ) then ! if the Projection of the collocation point ipts(:,i) is at vertex y3
	      Rh(3) = 0.0_dp
	      if (et == 0.0_dp) rho(3) = 0.0_dp ! ipts(:,i) = y3
	   endif

	   qetx2(1) = 2.0_dp*q(1)*et; qetx2(2) = 2.0_dp*q(2)*et; qetx2(3) = 2.0_dp*q(3)*et

	   p11rh1 = p11*rho(1); p12rh2 = p12*rho(2)
	   p22rh2 = p22*rho(2); p23rh3 = p23*rho(3)
	   p33rh3 = p33*rho(3); p31rh1 = p31*rho(1)


	   if ( rho(1) == 0.0_dp ) then ! if The collocation point ipts(:,i) is at vertex y1, i.e., ipts(:,i) = y1
	     gam = 0.0_dp
	     omega = q(2)*dlog( (p22+rho(2))/(p23+rho(3)) ) ! chi(2) = dlog( (p22+rho(2))/(p23+rho(3)) )

	   elseif ( rho(2) == 0.0_dp ) then ! if The collocation point ipts(:,i) is at vertex y2, i.e., ipts(:,i) = y2
	     gam = 0.0_dp
	     omega = q(3)*dlog( (p33+rho(3))/(p31+rho(1)) ) ! chi(3) = dlog( (p33+rho(3))/(p31+rho(1)) )

	   elseif ( rho(3) == 0.0_dp ) then ! if The collocation point ipts(:,i) is at vertex y3, i.e., ipts(:,i) = y3
	     gam = 0.0_dp
	     omega = q(1)*dlog( (p11+rho(1))/(p12+rho(2)) ) ! chi(1) = dlog( (p11+rho(1))/(p12+rho(2)) )

	   else

	   	   if ( Rh(1) == 0.0_dp ) then ! if the Projection of the collocation point ipts(:,i) is at vertex y1
	   	      cr22 = qs(2)*rh2s-p22*p22*ets; cr23 = qs(2)*rh3s-p23*p23*ets
	   	      zn2 = qetx2(2)*(p23rh3*cr22 - p22rh2*cr23); zd2 = cr22*cr23 + qetx2(2)*qetx2(2)*p22rh2*p23rh3
	   	      gam = gammai(p22,p23,qetx2(2),cr22,cr23,zn2,zd2) ! gam = gamma(2); gamma(1) = -gamma(3) = +pi or -pi

	   	   elseif ( Rh(2) == 0.0_dp ) then ! if the Projection of the collocation point ipts(:,i) is at vertex y2
	   	      cr33 = qs(3)*rh3s - p33s*ets; cr31 = qs(3)*rh1s - p31*p31*ets
	   	      zn3 = qetx2(3)*(p31rh1*cr33 - p33rh3*cr31); zd3 = cr31*cr33 + qetx2(3)*qetx2(3)*p31rh1*p33rh3
	   	      gam = gammai(p33,p31,qetx2(3),cr33,cr31,zn3,zd3) ! gam = gamma(3); gamma(1) = -gamma(2) = +pi or -pi

	   	   elseif ( Rh(3) == 0.0_dp ) then ! if the Projection of the collocation point ipts(:,i) is at vertex y3
	   	      cr11 = qs(1)*rh1s - p11s*ets; cr12 = qs(1)*rh2s - p12s*ets
	   	      zn1 = qetx2(1)*(p12rh2*cr11 - p11rh1*cr12); zd1 = cr11*cr12 + qetx2(1)*qetx2(1)*p11rh1*p12rh2
	   	      gam = gammai(p11,p12,qetx2(1),cr11,cr12,zn1,zd1) ! gam = gamma(1); gamma(2) = -gamma(3) = +pi or -pi

	   	   elseif ( q(1) == 0.0_dp ) then ! if the Projection of the collocation point ipts(:,i) is on the line parallel to edge [y1,y2]
	   	      cr22 = qs(2)*rh2s-p22*p22*ets; cr23 = qs(2)*rh3s-p23*p23*ets
	   	      zn2 = qetx2(2)*(p23rh3*cr22 - p22rh2*cr23); zd2 = cr22*cr23 + qetx2(2)*qetx2(2)*p22rh2*p23rh3

	   	      cr33 = qs(3)*rh3s - p33s*ets; cr31 = qs(3)*rh1s - p31*p31*ets
	   	      zn3 = qetx2(3)*(p31rh1*cr33 - p33rh3*cr31); zd3 = cr31*cr33 + qetx2(3)*qetx2(3)*p31rh1*p33rh3
	
	   	      gamma(2) = gammai(p22,p23,qetx2(2),cr22,cr23,zn2,zd2)
	   	      gamma(3) = gammai(p33,p31,qetx2(3),cr33,cr31,zn3,zd3)
	   	      gam = gamma(2)+gamma(3)

	   	   elseif ( q(2) == 0.0_dp ) then ! if the Projection of the collocation point ipts(:,i) is on the line parallel to edge [y2,y3]
	   	      cr11 = qs(1)*rh1s - p11s*ets; cr12 = qs(1)*rh2s - p12s*ets
	   	      zn1 = qetx2(1)*(p12rh2*cr11 - p11rh1*cr12); zd1 = cr11*cr12 + qetx2(1)*qetx2(1)*p11rh1*p12rh2

	   	      cr33 = qs(3)*rh3s - p33s*ets; cr31 = qs(3)*rh1s - p31*p31*ets
	   	      zn3 = qetx2(3)*(p31rh1*cr33 - p33rh3*cr31); zd3 = cr31*cr33 + qetx2(3)*qetx2(3)*p31rh1*p33rh3
	
	   	      gamma(1) = gammai(p11,p12,qetx2(1),cr11,cr12,zn1,zd1)
	   	      gamma(3) = gammai(p33,p31,qetx2(3),cr33,cr31,zn3,zd3)
	   	      gam = gamma(1)+gamma(3)

	   	   elseif ( q(3) == 0.0_dp ) then ! if the Projection of the collocation point ipts(:,i) is on the line parallel to edge [y3,y1]
	   	      cr11 = qs(1)*rh1s - p11s*ets; cr12 = qs(1)*rh2s - p12s*ets
	   	      zn1 = qetx2(1)*(p12rh2*cr11 - p11rh1*cr12); zd1 = cr11*cr12 + qetx2(1)*qetx2(1)*p11rh1*p12rh2

	   	      cr22 = qs(2)*rh2s-p22*p22*ets; cr23 = qs(2)*rh3s-p23*p23*ets
	   	      zn2 = qetx2(2)*(p23rh3*cr22 - p22rh2*cr23); zd2 = cr22*cr23 + qetx2(2)*qetx2(2)*p22rh2*p23rh3
	
	   	      gamma(1) = gammai(p11,p12,qetx2(1),cr11,cr12,zn1,zd1)
	   	      gamma(2) = gammai(p22,p23,qetx2(2),cr22,cr23,zn2,zd2)
	   	      gam = gamma(1)+gamma(2)

	   	   else
	   	      cr11 = qs(1)*rh1s - p11s*ets; cr12 = qs(1)*rh2s - p12s*ets
	   	      zn1 = qetx2(1)*(p12rh2*cr11 - p11rh1*cr12); zd1 = cr11*cr12 + qetx2(1)*qetx2(1)*p11rh1*p12rh2

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

	   	      cr33 = qs(3)*rh3s - p33s*ets; cr31 = qs(3)*rh1s - p31*p31*ets
	   	      zn3 = qetx2(3)*(p31rh1*cr33 - p33rh3*cr31); zd3 = cr31*cr33 + qetx2(3)*qetx2(3)*p31rh1*p33rh3
	
	   	      gamma(1) = gammai(p11,p12,qetx2(1),cr11,cr12,zn1,zd1)
	   	      gamma(2) = gammai(p22,p23,qetx2(2),cr22,cr23,zn2,zd2)
	   	      gamma(3) = gammai(p33,p31,qetx2(3),cr33,cr31,zn3,zd3)
	   	      gam = gamma(1)+gamma(2)+gamma(3)

	   	   endif

	   	   ch11 = p11+rho(1); ch12 = p12+rho(2)
	   	   ch22 = p22+rho(2); ch23 = p23+rho(3)
	   	   ch33 = p33+rho(3); ch31 = p31+rho(1)

	   	   if ( (ch11 >= f_eps) .and. (ch12 >= f_eps) ) then
	   	      chi(1) = dlog(ch11/ch12)
	   	   else
	   	      chi(1) = asym_chi(p11,p12,qs(1) + ets)
	   	   endif

	   	   if ( (ch22 >= f_eps) .and. (ch23 >= f_eps) ) then
	   	      chi(2) = dlog(ch22/ch23)
	   	   else
	   	      chi(2) = asym_chi(p22,p23,qs(2) + ets)
	   	   endif

	   	   if ( (ch33 >= f_eps) .and. (ch31 >= f_eps) ) then
	   	      chi(3) = dlog(ch33/ch31)
	   	   else
	   	      chi(3) = asym_chi(p33,p31,qs(3) + ets)
	   	   endif

	   	   omega = q(1)*chi(1) + q(2)*chi(2) + q(3)*chi(3)

	   endif ! if The collocation point ipts(:,i) is at vertex y1, i.e., ipts(:,i) = y1

	  if ( et >= 0.0_dp ) then
	     ThetGam = 0.5_dp*gam + theta0
	  else
	     ThetGam = 0.5_dp*gam - theta0
	  endif
	
	  fldvl(i) = fldvl(i) + (omega - et*ThetGam)*flx(elQ) + ThetGam*phi(elQ)

       enddo loop4 ! Loop over all interior points
    enddo loop1 ! Loop over all boundary elements
    
    
    loop6: do k=1,nip ! Loop over all interior points
       fldvl(k) = fac*fldvl(k) ! Correct the potential at all interior points by the factor fac
    enddo loop6

!----------------------------------------------------------------------------------------------------------------------------------!
END SUBROUTINE cbem_lap_fld_eval
!----------------------------------------------------------------------------------------------------------------------------------!
