source: vendors/PPR/example/ex_6.f90 @ 15787

!   gfortran -cpp -O3 -flto ex_6.f90 -o ex_6
!   ./ex_6

!   1d scalar transport in a periodic domain. Fluxes are
!   computed in a flux-form semi-lagrangian sense -- 
!   integrating over the upwind regions "swept" by edges
!   in each time-step. This implementation requires CFL<1,
!   with the upwind regions covering adjacent cells only. 
!   A CFL>=1 variant could be constructed using RMAP1D().
!

#   include "../src/ppr_1d.f90"

    program ex

        use ppr_1d

        implicit none

        integer, parameter :: halo = 4  ! halo cells at boundary
        integer, parameter :: npos = 51 ! no. edge 
        integer, parameter :: nvar = 1  ! no. tracers to trnsprt
        integer, parameter :: ndof = 1  ! no. FV DoF per cell
        integer :: ipos,il,ir,step

    !------------------------------- domain discretisation !
        real*8  :: xpos(1-halo:npos+halo)
        real*8  :: xmid,xdel(1),tDEL
        
    !-------------------------------- finite-volume arrays !

    !   INIT: initial cell-wise finite-volume profile
    !   QBAR: dynamic cell-wise finite-volume profile
    !   MASK: cell-wise "land" mask (all TRUE here)
    !   UVEL: edge-wise velocity distribution
    !   FLUX: edge-wise distribution of upwind fluxes
    !   QDIV: cell-wise distribution of divergence

        real*8  :: init(ndof,nvar,1-halo:npos+halo-1)
        real*8  :: qbar(ndof,nvar,1-halo:npos+halo-1)
        logical :: mask(          1-halo:npos+halo-1)
        real*8  :: uvel(          1-halo:npos+halo)        
        real*8  :: flux(     nvar,1-halo:npos+halo)        
        real*8  :: qdiv(     nvar,1-halo:npos+halo-1)
        

    !------------------------------ method data-structures !
        type(rmap_work) :: work
        type(rmap_opts) :: opts
        type(rcon_ends) :: bc_l(nvar)
        type(rcon_ends) :: bc_r(nvar)

    !------------------------------ define a simple domain !

        il =      + 1                   ! 1st real interior cell
        ir = npos - 1                   ! Nth real interior cell

        xpos(il+0) = 0.0d+00
        xpos(ir+1) = 1.0d+00
        
        xdel(1) = (xpos(ir+1)-xpos(il+0))/(npos-1)

        do ipos = il+1, ir-0

            xpos(ipos) = (ipos-1) * xdel(1)         

        end do

    !------------------------------ setup some simple data !

        uvel       = +1.0d+0
        mask       = .true.

        tDEL       = +1.0d-2

        do ipos = +1, npos-1

            xmid = xpos(ipos+0)* 0.5d+00 &
    &            + xpos(ipos+1)* 0.5d+00

            init(1,1,ipos) = &
    &   .8d+0 * exp( -75.0d+0 * (xmid - 0.275d+0) ** 2 ) &
    & + .9d+0 * exp(-100.0d+0 * (xmid - 0.500d+0) ** 2 ) &
    & + 1.d+0 * exp(-125.0d+0 * (xmid - 0.725d+0) ** 2 )
            
        end do

    !------------------------------ specify method options !

        opts%edge_meth = p3e_method     ! 3rd-order edge interp.
        opts%cell_meth = ppm_method     ! PPM method in cells
        opts%cell_lims = weno_limit     ! "non-oscillatory" lim.
        
    !------------------------------ set BC.'s at endpoints !

        bc_l%bcopt = bcon_loose         ! "loose" = extrapolate
        bc_r%bcopt = bcon_loose

    !------------------------------ init. method workspace !

        call work%init(npos+2*halo,nvar,opts)

    !------------------------------ calc. scalar transport !

        qbar = init

        do step = +1, +100        ! 100 steps => full loop

    !------------------------------ periodicity via halo's !

            qbar(1,:,il-halo:il-1) = & 
    &       qbar(1,:,ir-halo+1:ir)
            qbar(1,:,ir+1:ir+halo) = &
    &       qbar(1,:,il:il+halo-1)

    !------------------------------ form lagrangian fluxes !

            call ffsl1d (npos+2*halo,nvar, &
    &            ndof,xdel,tDEL,mask,uvel, &
    &            qbar,flux,bc_l,bc_r,work, &
    &            opts)

  
    !------------------------------ flux divergence eval's !
            qdiv(  1,il:ir) = &
    &              flux(1,il+1:ir+1) &
    &            - flux(1,il+0:ir+0)

    !------------------------------ take a single timestep !

            qbar(1,1,il:ir) = &
    &           qbar(1,1,il:ir) - &
    &               qdiv(1,il:ir) / xdel(1)

        end do

    !------------------------------ clear method workspace !

        call work%free()

    !------------------------------ dump results to stdout !

        print*,"End timestep profile : "

        do ipos = il+0, ir-0

            print *, init(1,:,ipos)  &
    &              , qbar(1,:,ipos)

        end do

        print*,"Conservation defect := " &
    &         , sum(init(1,:,il:ir)) &
    &         - sum(qbar(1,:,il:ir))
        
    end program