New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
ex_2.f90 in vendors/PPR/example – NEMO

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

Last change on this file since 15787 was 13926, checked in by jchanut, 4 years ago

#2222, add Piecewise Polynomial Reconstruction library

File size: 3.6 KB
Line 
1
2!   gfortran -cpp -O3 -flto ex_2.f90 -o ex_2
3!   ./ex_2
4
5!   Test for the monotone limiter: remap a stairstep profile
6!   between randomly perturbed grids. When MONO-LIMIT is
7!   selected, all methods should lead to monotone behaviour.
8!
9
10#   include "../src/ppr_1d.f90"
11
12    program ex
13
14        use ppr_1d
15
16        implicit none
17
18        integer, parameter :: npos = 47 ! no. edge (old grid)
19        integer, parameter :: ntmp = 37 ! no. edge (new grid)
20        integer, parameter :: nvar = 1  ! no. variables to remap
21        integer, parameter :: ndof = 1  ! no. FV DoF per cell
22        integer :: ipos
23
24    !------------------------------ position of cell edges !
25        real*8  :: xpos(npos),xtmp(ntmp)
26        real*8  :: xmid
27       
28    !-------------------------------- finite-volume arrays !
29
30    !   Arrays represent a "block" of finite-volume tracers
31    !   to remap. The 1st dim. is the no. of DoF per cell,
32    !   NDOF=1 is a standard finite-volume scheme where the
33    !   data is specified as cell means. NDOF>1 is reserved
34    !   for future use with DG-style schemes. NVAR is the
35    !   number of tracers to remap. Processing tracers in a
36    !   batch is typically more efficient than one-by-one.
37    !   The last dim. is the no. cells (layers) in the grid.
38
39        real*8  :: init(ndof,nvar,npos-1)
40        real*8  :: fdat(ndof,nvar,npos-1)       
41        real*8  :: ftmp(ndof,nvar,ntmp-1)
42       
43    !------------------------------ method data-structures !
44        type(rmap_work) :: work
45        type(rmap_opts) :: opts
46        type(rcon_ends) :: bc_l(nvar)
47        type(rcon_ends) :: bc_r(nvar)
48
49    !------------------------------ define a simple domain !
50
51        call linspace(0.d0,1.d0,npos,xpos)
52        call rndspace(0.d0,1.d0,ntmp,xtmp)
53
54    !------------------------------ setup some simple data !
55
56        do ipos = +1, npos-1
57
58            xmid = xpos(ipos+0) * 0.5d+0 &
59        &        + xpos(ipos+1) * 0.5d+0
60
61            if (xmid .lt. 0.33d0) then
62            init(1,1,ipos) = +1.0d0
63            else &
64            if (xmid .lt. 0.67d0) then
65            init(1,1,ipos) = +2.0d0
66            else
67            init(1,1,ipos) = +0.0d0
68            end if
69
70        end do
71
72    !------------------------------ specify method options !
73
74        opts%edge_meth = p5e_method     ! 5th-order edge interp.
75        opts%cell_meth = pqm_method     ! PQM method in cells
76        opts%cell_lims = mono_limit     ! monotone limiter
77       
78    !------------------------------ set BC.'s at endpoints !
79
80        bc_l%bcopt = bcon_loose         ! "loose" = extrapolate
81        bc_r%bcopt = bcon_loose
82
83    !------------------------------ init. method workspace !
84
85        call work%init(npos,nvar,opts)
86
87    !------------------------------ re-map back-and-forth: !
88
89        fdat = init
90
91        do ipos = +1, +1000
92
93    !------------------------------ re-map from dat-to-tmp !
94
95        call rmap1d(npos,ntmp,nvar,ndof, &
96        &           xpos,xtmp,fdat,ftmp, &
97        &           bc_l,bc_r,work,opts)
98
99    !------------------------------ re-map from tmp-to-dat !
100
101        call rmap1d(ntmp,npos,nvar,ndof, &
102        &           xtmp,xpos,ftmp,fdat, &
103        &           bc_l,bc_r,work,opts)
104
105        end do
106
107    !------------------------------ clear method workspace !
108
109        call work%free()
110
111    !------------------------------ dump results to stdout !
112
113        print*,"Cell data: [INIT] [RMAP] "
114
115        do ipos = +1, npos-1
116
117            print *, init(1,1,ipos) &
118        &          , fdat(1,1,ipos)
119
120        end do
121
122        print*,"Conservation defect := " &
123        &     , sum(init) - sum(fdat)
124
125    end program
126
127
128
Note: See TracBrowser for help on using the repository browser.