!----------------------------------------------------------------------------------------------------------------------------------!
PROGRAM gbem3d_lapeq
!----------------------------------------------------------------------------------------------------------------------------------!

!===purpose===! 

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

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


USE KINDS
USE SRF_GEOM, ONLY: nbnd,bnd ! nbnd == Total number of boundary nodes
			     ! bnd(:,i) == Cartesian coordinates of the i-th boundary node
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,l,alloc_st,nintpts ! nintpts == Number of interior points
 real   (kind=dp)  :: tm0, tm1 ! time variables
 real   (kind=dp)  :: Perr,Ferr
 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



    call cpu_time(tm0) ! Initial time

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

    call gbem_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(nbnd),STAT=alloc_st)
    if ( alloc_st /= 0 ) then ! If extsol is not successfully allocated 
       write(*,*)'lap_ex: 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','GBEM','Exact','Error'
       loop12: do i=1,nbnd ! Loop over all boundary nodes
	 extsol(i) = dexp(bnd(1,i))*dsin(bnd(3,i)) + dexp(bnd(3,i))*dcos(bnd(2,i)) ! Exact solution
        write(54,999) i, bnd(:,i), phi(i), extsol(i), dabs(extsol(i)-phi(i))
       enddo loop12
    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','GBEM','Exact','Error'
       
	l=int(nbnd/6) ! l==Number of boundary nodes per face of the cube
       loop13a: do i=1,6 ! loop over all faces
          loop13b: do k=(i-1)*l+1,i*l ! Loop over all boundary nodes on the i-th face
	     if (i==1) then    ! face: x=0
	        extsol(k) = -dexp(bnd(1,k))*dsin(bnd(3,k))
	     elseif(i==2) then ! face: x=1
	        extsol(k) =  dexp(bnd(1,k))*dsin(bnd(3,k))
	     elseif(i==3) then ! face: y=0
	        extsol(k) =  dexp(bnd(3,k))*dsin(bnd(2,k))
	     elseif(i==4) then ! face: y=1
	        extsol(k) = -dexp(bnd(3,k))*dsin(bnd(2,k))
	     elseif(i==5) then ! face: z=0
	        extsol(k) = -dexp(bnd(1,k))*dcos(bnd(3,k)) - dexp(bnd(3,k))*dcos(bnd(2,k))
	     elseif(i==6) then ! face: z=1
	        extsol(k) =  dexp(bnd(1,k))*dcos(bnd(3,k)) + dexp(bnd(3,k))*dcos(bnd(2,k))
	     endif

	     write(55,999) k, bnd(:,k), flx(k), extsol(k), dabs(extsol(k)-flx(k)) ! absolute error
          enddo loop13b
       enddo loop13a
    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 /= 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 gbem_lap_fld_eval(nintpts,intpts,pot_ip) ! Compute the potential at interior points

    write(*,*)'        GBEM   ','                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
    call gbem_lap_del ! Deallocate remaining global arrays associated with the GALERKIN BEM
!*** End Deallocate remaining Global arrays
    
    call cpu_time(tm1) ! Current time
    write(*,*)'Time == ',tm1-tm0,'s'


100 format (1x, a)
 1640  format(' r/c ', 2I5, 'symm ', 3E18.6)
  999  format(I4, 1x, 5F16.8,1x,2E16.8)
 6781  format(' error ')
  993  format(I3, 2x, 2F16.8)
  991  format(I3, 2x, 2F16.8)
  989   format('row ',I6,' sum = ',F12.6)
 1000 format(1x,a,t16,a,t32,a,t48,a,t63,a,t79,a,t93,a) 

!----------------------------------------------------------------------------------------------------------------------------------!
END PROGRAM gbem3d_lapeq
!----------------------------------------------------------------------------------------------------------------------------------!
