@@ -33,6 +33,8 @@ module MOM_remapping
33
33
logical :: check_remapping = .false.
34
34
! > If true, the intermediate values used in remapping are forced to be bounded.
35
35
logical :: force_bounds_in_subcell = .false.
36
+ ! > If true use older, less acccurate expressions.
37
+ logical :: answers_2018 = .true.
36
38
end type
37
39
38
40
! The following routines are visible to the outside world
@@ -84,13 +86,14 @@ module MOM_remapping
84
86
85
87
! > Set parameters within remapping object
86
88
subroutine remapping_set_param (CS , remapping_scheme , boundary_extrapolation , &
87
- check_reconstruction , check_remapping , force_bounds_in_subcell )
89
+ check_reconstruction , check_remapping , force_bounds_in_subcell , answers_2018 )
88
90
type (remapping_CS), intent (inout ) :: CS ! < Remapping control structure
89
91
character (len=* ), optional , intent (in ) :: remapping_scheme ! < Remapping scheme to use
90
92
logical , optional , intent (in ) :: boundary_extrapolation ! < Indicate to extrapolate in boundary cells
91
93
logical , optional , intent (in ) :: check_reconstruction ! < Indicate to check reconstructions
92
94
logical , optional , intent (in ) :: check_remapping ! < Indicate to check results of remapping
93
95
logical , optional , intent (in ) :: force_bounds_in_subcell ! < Force subcells values to be bounded
96
+ logical , optional , intent (in ) :: answers_2018 ! < If true use older, less acccurate expressions.
94
97
95
98
if (present (remapping_scheme)) then
96
99
call setReconstructionType( remapping_scheme, CS )
@@ -107,6 +110,9 @@ subroutine remapping_set_param(CS, remapping_scheme, boundary_extrapolation, &
107
110
if (present (force_bounds_in_subcell)) then
108
111
CS% force_bounds_in_subcell = force_bounds_in_subcell
109
112
endif
113
+ if (present (answers_2018)) then
114
+ CS% answers_2018 = answers_2018
115
+ endif
110
116
end subroutine remapping_set_param
111
117
112
118
subroutine extract_member_remapping_CS (CS , remapping_scheme , degree , boundary_extrapolation , check_reconstruction , &
@@ -392,31 +398,31 @@ subroutine build_reconstructions_1d( CS, n0, h0, u0, ppoly_r_coefs, &
392
398
endif
393
399
iMethod = INTEGRATION_PLM
394
400
case ( REMAPPING_PPM_H4 )
395
- call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge )
401
+ call edge_values_explicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018 = CS % answers_2018 )
396
402
call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect )
397
403
if ( CS% boundary_extrapolation ) then
398
404
call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect )
399
405
endif
400
406
iMethod = INTEGRATION_PPM
401
407
case ( REMAPPING_PPM_IH4 )
402
- call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge )
408
+ call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018 = CS % answers_2018 )
403
409
call PPM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect )
404
410
if ( CS% boundary_extrapolation ) then
405
411
call PPM_boundary_extrapolation( n0, h0, u0, ppoly_r_E, ppoly_r_coefs, h_neglect )
406
412
endif
407
413
iMethod = INTEGRATION_PPM
408
414
case ( REMAPPING_PQM_IH4IH3 )
409
- call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge )
410
- call edge_slopes_implicit_h3( n0, h0, u0, ppoly_r_S, h_neglect )
415
+ call edge_values_implicit_h4( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018 = CS % answers_2018 )
416
+ call edge_slopes_implicit_h3( n0, h0, u0, ppoly_r_S, h_neglect, answers_2018 = CS % answers_2018 )
411
417
call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefs, h_neglect )
412
418
if ( CS% boundary_extrapolation ) then
413
419
call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, &
414
420
ppoly_r_coefs, h_neglect )
415
421
endif
416
422
iMethod = INTEGRATION_PQM
417
423
case ( REMAPPING_PQM_IH6IH5 )
418
- call edge_values_implicit_h6( n0, h0, u0, ppoly_r_E, h_neglect_edge )
419
- call edge_slopes_implicit_h5( n0, h0, u0, ppoly_r_S, h_neglect )
424
+ call edge_values_implicit_h6( n0, h0, u0, ppoly_r_E, h_neglect_edge, answers_2018 = CS % answers_2018 )
425
+ call edge_slopes_implicit_h5( n0, h0, u0, ppoly_r_S, h_neglect, answers_2018 = CS % answers_2018 )
420
426
call PQM_reconstruction( n0, h0, u0, ppoly_r_E, ppoly_r_S, ppoly_r_coefs, h_neglect )
421
427
if ( CS% boundary_extrapolation ) then
422
428
call PQM_boundary_extrapolation_v1( n0, h0, u0, ppoly_r_E, ppoly_r_S, &
@@ -1537,19 +1543,20 @@ end subroutine dzFromH1H2
1537
1543
1538
1544
! > Constructor for remapping control structure
1539
1545
subroutine initialize_remapping ( CS , remapping_scheme , boundary_extrapolation , &
1540
- check_reconstruction , check_remapping , force_bounds_in_subcell )
1546
+ check_reconstruction , check_remapping , force_bounds_in_subcell , answers_2018 )
1541
1547
! Arguments
1542
1548
type (remapping_CS), intent (inout ) :: CS ! < Remapping control structure
1543
1549
character (len=* ), intent (in ) :: remapping_scheme ! < Remapping scheme to use
1544
1550
logical , optional , intent (in ) :: boundary_extrapolation ! < Indicate to extrapolate in boundary cells
1545
1551
logical , optional , intent (in ) :: check_reconstruction ! < Indicate to check reconstructions
1546
1552
logical , optional , intent (in ) :: check_remapping ! < Indicate to check results of remapping
1547
1553
logical , optional , intent (in ) :: force_bounds_in_subcell ! < Force subcells values to be bounded
1554
+ logical , optional , intent (in ) :: answers_2018 ! < If true use older, less acccurate expressions.
1548
1555
1549
- ! Note that remapping_scheme is mandatory fir initialize_remapping()
1556
+ ! Note that remapping_scheme is mandatory for initialize_remapping()
1550
1557
call remapping_set_param(CS, remapping_scheme= remapping_scheme, boundary_extrapolation= boundary_extrapolation, &
1551
1558
check_reconstruction= check_reconstruction, check_remapping= check_remapping, &
1552
- force_bounds_in_subcell= force_bounds_in_subcell)
1559
+ force_bounds_in_subcell= force_bounds_in_subcell, answers_2018 = answers_2018 )
1553
1560
1554
1561
end subroutine initialize_remapping
1555
1562
@@ -1615,13 +1622,15 @@ logical function remapping_unit_tests(verbose)
1615
1622
data h2 / 6 * 0.5 / ! 6 uniform layers with total depth of 3
1616
1623
type (remapping_CS) :: CS ! < Remapping control structure
1617
1624
real , allocatable , dimension (:,:) :: ppoly0_E, ppoly0_S, ppoly0_coefs
1625
+ logical :: answers_2018 ! If true use older, less acccurate expressions.
1618
1626
integer :: i
1619
1627
real :: err, h_neglect, h_neglect_edge
1620
1628
logical :: thisTest, v
1621
1629
1622
1630
v = verbose
1623
1631
h_neglect = hNeglect_dflt
1624
1632
h_neglect_edge = 1.0e-10
1633
+ answers_2018 = .true.
1625
1634
1626
1635
write (* ,* ) ' ==== MOM_remapping: remapping_unit_tests ================='
1627
1636
remapping_unit_tests = .false. ! Normally return false
@@ -1643,7 +1652,7 @@ logical function remapping_unit_tests(verbose)
1643
1652
remapping_unit_tests = remapping_unit_tests .or. thisTest
1644
1653
1645
1654
thisTest = .false.
1646
- call initialize_remapping(CS, ' PPM_H4' )
1655
+ call initialize_remapping(CS, ' PPM_H4' , answers_2018 = answers_2018 )
1647
1656
if (verbose) write (* ,* ) ' h0 (test data)'
1648
1657
if (verbose) call dumpGrid(n0,h0,x0,u0)
1649
1658
@@ -1667,7 +1676,7 @@ logical function remapping_unit_tests(verbose)
1667
1676
ppoly0_S(:,:) = 0.0
1668
1677
ppoly0_coefs(:,:) = 0.0
1669
1678
1670
- call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect= 1e-10 )
1679
+ call edge_values_explicit_h4( n0, h0, u0, ppoly0_E, h_neglect= 1e-10 , answers_2018 = answers_2018 )
1671
1680
call PPM_reconstruction( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect )
1672
1681
call PPM_boundary_extrapolation( n0, h0, u0, ppoly0_E, ppoly0_coefs, h_neglect )
1673
1682
u1(:) = 0 .
@@ -1798,7 +1807,7 @@ logical function remapping_unit_tests(verbose)
1798
1807
test_answer(v, 3 , ppoly0_coefs(:,2 ), (/ 0 .,4 .,0 ./ ), ' Non-uniform line PLM: P1' )
1799
1808
1800
1809
call edge_values_explicit_h4( 5 , (/ 1 .,1 .,1 .,1 .,1 ./ ), (/ 1 .,3 .,5 .,7 .,9 ./ ), ppoly0_E, &
1801
- h_neglect= 1e-10 )
1810
+ h_neglect= 1e-10 , answers_2018 = answers_2018 )
1802
1811
! The next two tests currently fail due to roundoff.
1803
1812
thisTest = test_answer(v, 5 , ppoly0_E(:,1 ), (/ 0 .,2 .,4 .,6 .,8 ./ ), ' Line H4: left edges' )
1804
1813
thisTest = test_answer(v, 5 , ppoly0_E(:,2 ), (/ 2 .,4 .,6 .,8 .,10 ./ ), ' Line H4: right edges' )
@@ -1814,7 +1823,7 @@ logical function remapping_unit_tests(verbose)
1814
1823
test_answer(v, 5 , ppoly0_coefs(:,3 ), (/ 0 .,0 .,0 .,0 .,0 ./ ), ' Line PPM: P2' )
1815
1824
1816
1825
call edge_values_explicit_h4( 5 , (/ 1 .,1 .,1 .,1 .,1 ./ ), (/ 1 .,1 .,7 .,19 .,37 ./ ), ppoly0_E, &
1817
- h_neglect= 1e-10 )
1826
+ h_neglect= 1e-10 , answers_2018 = answers_2018 )
1818
1827
! The next two tests currently fail due to roundoff.
1819
1828
thisTest = test_answer(v, 5 , ppoly0_E(:,1 ), (/ 3 .,0 .,3 .,12 .,27 ./ ), ' Parabola H4: left edges' )
1820
1829
thisTest = test_answer(v, 5 , ppoly0_E(:,2 ), (/ 0 .,3 .,12 .,27 .,48 ./ ), ' Parabola H4: right edges' )
0 commit comments