!----------------------------------------------------------------------------------------------------------------------------------!
PROGRAM cbem3d_lapeq
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

!**********************************************************************************************************************************!
!********************************  COLLOCATION BEM for 3D LAPLACE EQUATION: SINGULAR FORMULATION  *********************************!
!***************************************  3-NODED TRIANGULAR ELEMENT: ANALYTIC INTEGRATION  ***************************************!
!***********************************************  PIECEWISE CONSTANT APPROXIMATION  ***********************************************!
!*******************************************************  Example routine  ********************************************************!
!**********************************************************************************************************************************!

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


USE KINDS
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,i) == Global index of the k-th node on the boundary element i
USE SRF_GEOM, ONLY: bnd,repnd  ! bnd(:,k) == Cartesian coordinates of the k-th boundary node
                               ! repnd(:,i) == Cartesian coordinates of the centroid of the i-th boundary triangle
USE POTFLUX,  ONLY: phi, flx   ! phi == Vector containing boundary potentials
                               ! flx == Vector containing boundary fluxes


IMPLICIT NONE

 character(len=72) :: InputFileData, InputFileParams
 integer(kind=k9) :: i,k,j,alloc_st,nintpts ! nintpts == Number of interior points
 real   (kind=dp) :: tm0, tm1    ! time variables
 real   (kind=dp), pointer :: extsol(:)    ! Exact solution
 real   (kind=dp), pointer :: intpts(:,:)  ! intpts(:,i) == Cartesian coordinates of the i-th interior (or field) point
 real   (kind=dp), pointer :: pot_ip(:)    ! pot_ip(i) == Potential at the i-th interior point
 real   (kind=dp) :: r12(3),r13(3)
 real   (kind=dp) :: xeQ(3,mx_nd_elt)  ! xeQ(:,k) == Cartesian coordinates of the k-th vertex on the current surface triangle
 real   (kind=dp) :: e1(3),e2(3),e3(3) ! Orthonormal local basis associated with the current surface triangle
 real   (kind=dp) :: Perr,Ferr



    call cpu_time(tm0)    ! Initial time

    InputFileData = 'bndata.dat'; InputFileParams = 'cbem_lap_par.dat'

     call cbem_lap_srf_eval(InputFileParams,InputFileData,tm0)    ! Solve the Singular BIE for the Laplace equation

    call cpu_time(tm1)    ! Current time
    write(*,*)'Time == ',tm1-tm0,'s'

    write(*,100)' >>>  Write the boundary potential and flux at Discrete boundary nodes  <<<'

    allocate(extsol(nbelt),STAT=alloc_st)
    if ( alloc_st .ne. 0 ) then  ! If extsol is not successfully allocated 
       write(*,*)'lap_ex.f90: Allocate array "extsol" failed with Status=',alloc_st
       stop
    endif

    open (unit=54, file='potl.dat', action='write')
       write(54,*) ' phi '
       write(54,1000)'Nodes','x','y','z','CBEM','Exact','Error'
       loop0: do i=1,nbelt    ! Loop over all boundary elements
	 extsol(i) = dexp(repnd(1,i))*dsin(repnd(3,i)) + dexp(repnd(3,i))*dcos(repnd(2,i))   ! Exact solution
        write(54,999) i, repnd(:,i), phi(i), extsol(i), dabs(extsol(i)-phi(i))
       enddo loop0
    close(unit=54, status='keep')
    Perr = dsqrt(dot_product(phi-extsol,phi-extsol)/dot_product(extsol,extsol))
    write(*,*)'Relative Error on Potential == ',Perr


    open (unit=55, file='flux.dat', action='write')
        write(55,*) ' flux '
	write(55,1000)'Nodes','x','y','z','CBEM','Exact','Error'
       loop1a: do i=1,nbelt    ! Loop over all boundary elements
           loop1b: do k=1,mx_nd_elt    ! Loop over the vertices of the i-th element
              loop1c: do j=1,3    ! Loop over all components
                 xeQ(j,k) = bnd(j,belt(k,i))  ! xeQ(:,k) == Cartesian coordinates of the k-th vertex of element i
		                              ! belt(k,i) == Global index of the k-th node on the boundary element i
              enddo loop1c
           enddo loop1b
	   r12 = xeQ(:,2)-xeQ(:,1); r13 = xeQ(:,3)-xeQ(:,1)

           call ortho_comp_basis(r12,r13,e1,e2,e3) ! Deternime the orthonormal local basis associated with element i

	   extsol(i) = dexp(repnd(1,i))*dsin(repnd(3,i))*e3(1) - dexp(repnd(3,i))*dsin(repnd(2,i))*e3(2) + &
	              (dexp(repnd(1,i))*dcos(repnd(3,i)) + dexp(repnd(3,i))*dcos(repnd(2,i)) )*e3(3)    ! Exact solution

	write(55,999) i, repnd(:,i), flx(i), extsol(i), dabs(extsol(i)-flx(i))
       enddo loop1a
    close(unit=55, status='keep')
    Ferr = dsqrt(dot_product(flx-extsol,flx-extsol)/dot_product(extsol,extsol))
    write(*,*)'Relative Error on Flux == ',Ferr
    write(*,*)'Relative Error on Potential & Flux == ',0.5_dp*(Perr+Ferr)

    deallocate(extsol)

!*** Evaluation at interior point
    write(*,*)'****Evaluation at interior points****'
    nintpts = 3
    allocate(intpts(3,nintpts),pot_ip(nintpts),STAT=alloc_st)
    if ( alloc_st .ne. 0 ) then  ! If intpts, pot_ip are not successfully allocated 
       write(*,*)'lap_ex.f90: Allocate arrays "intpts, pot_ip" failed with Status=',alloc_st
       stop
    endif
    
    intpts(1,1) = 0.000001_dp; intpts(2,1) = 0.0001_dp; intpts(3,1) = 0.999_dp
    intpts(1,2) = 0.100_dp;    intpts(2,2) = 0.300_dp;  intpts(3,2) = 0.700_dp
    intpts(1,3) = 0.500_dp;    intpts(2,3) = 0.500_dp;  intpts(3,3) = 0.500_dp
    
    call cbem_lap_fld_eval(nintpts,intpts,pot_ip)  ! Compute the potential at interior points

    write(*,*)'        CBEM   ','                Exact'
    do i=1,nintpts
       write(*,*)pot_ip(i),dexp(intpts(1,i))*dsin(intpts(3,i)) + dexp(intpts(3,i))*dcos(intpts(2,i))
    enddo

    deallocate(intpts,pot_ip)

!*** Deallocate remaining Global arrays
    deallocate(phi, flx) 
    deallocate(bnd,repnd)
    deallocate(belt)
!*** End Deallocate remaining Global arrays

    call cpu_time(tm1)    ! Current time
    write(*,*)'Time == ',tm1-tm0,'s'



  100 format(1x, a)
  999 format(I5, 1x, 5F16.8,1x,2E16.8)
 1000 format(1x,a,t16,a,t32,a,t48,a,t63,a,t79,a,t93,a) 

!----------------------------------------------------------------------------------------------------------------------------------!
END PROGRAM cbem3d_lapeq
!----------------------------------------------------------------------------------------------------------------------------------!
