From e2e7312d507d473d6d3b5b4c248a04153dea6c0b Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 30 Jan 2017 15:54:34 +0100 Subject: [PATCH 01/90] New branch weno_interpolation Short description Why: New branch created for the implementation of WENO interpolation This change addresses the need by: Extend the WENO interpolator to the interpolation of values. Side effects: None --- .../wenoof_interpolations_int_js.F90 | 359 ++++++++++++++++++ 1 file changed, 359 insertions(+) create mode 100644 src/lib/concrete_objects/wenoof_interpolations_int_js.F90 diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 new file mode 100644 index 0000000..89eec70 --- /dev/null +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -0,0 +1,359 @@ +!< Jiang-Shu (Lagrange) interpolations object for function interpolation. +module wenoof_interpolations_int_js +!< Jiang-Shu (Lagrange) interpolations object for function interpolation. +!< +!< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially +!< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, +!< doi:10.1137/070679065. + +#ifdef r16p +use penf, only: I_P, RPP=>R16P +#else +use penf, only: I_P, RPP=>R8P +#endif +use wenoof_base_object +use wenoof_interpolations_object + +implicit none +private +public :: interpolations_int_js +public :: interpolations_int_js_constructor + +type, extends(interpolations_object_constructor) :: interpolations_int_js_constructor + !< Jiang-Shu (Lagrange) interpolations object for function interpolation constructor. +endtype interpolations_int_js_constructor + +type, extends(interpolations_object) :: interpolations_int_js + !< Jiang-Shu (Lagrange) interpolations object for function interpolation. + !< + !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially + !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, + !< doi:10.1137/070679065. + private + real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [1:2,0:S-1,0:S-1]. + contains + ! public deferred methods + procedure, pass(self) :: create !< Create interpolations. + procedure, pass(self) :: compute !< Compute interpolations. + procedure, pass(self) :: description !< Return interpolations string-description. + procedure, pass(self) :: destroy !< Destroy interpolations. +endtype interpolations_rec_js + +contains + ! public deferred methods + subroutine create(self, constructor) + !< Create interpolations. + class(interpolations_int_js), intent(inout) :: self !< Interpolations. + class(base_object_constructor), intent(in) :: constructor !< Interpolations constructor. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(1:2, 0:self%S - 1)) + self%values = 0._RPP + allocate(self%coef(1:2, 0:self%S - 1, 0:self%S - 1)) + associate(c => self%coef) + select case(self%S) + case(2) ! 3rd order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 + c(1,0,0)= 0.5_RPP; c(1,1,0)= 0.5_RPP ! stencil 0 + c(1,0,1)= 1.5_RPP; c(1,1,1)= -0.5_RPP ! stencil 1 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 + c(2,0,0)= -0.5_RPP; c(2,1,0)= 1.5_RPP ! stencil 0 + c(2,0,1)= 0.5_RPP; c(2,1,1)= 0.5_RPP ! stencil 1 + case(3) ! 5th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 + c(1,0,0)= -1._RPP/8._RPP; c(1,1,0)= 3._RPP/4._RPP; c(1,2,0)= 3._RPP/8._RPP ! stencil 0 + c(1,0,1)= 3._RPP/8._RPP; c(1,1,1)= 3._RPP/4._RPP; c(1,2,1)= -1._RPP/8._RPP ! stencil 1 + c(1,0,2)= 15._RPP/8._RPP; c(1,1,2)= -5._RPP/4._RPP; c(1,2,2)= 3._RPP/8._RPP ! stencil 2 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 + c(2,0,0)= 3._RPP/8._RPP; c(2,1,0)= -5._RPP/4._RPP; c(2,2,0)= 15._RPP/8._RPP ! stencil 0 + c(2,0,1)= -1._RPP/8._RPP; c(2,1,1)= 3._RPP/4._RPP; c(2,2,1)= 3._RPP/8._RPP ! stencil 1 + c(2,0,2)= 3._RPP/8._RPP; c(2,1,2)= 3._RPP/4._RPP; c(2,2,2)= -1._RPP/8._RPP ! stencil 2 + case(4) ! 7th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(1,0,0)= 1._RPP/16._RPP; c(1,1,0)= -5._RPP/16._RPP; c(1,2,0)= 15._RPP/16._RPP; c(1,3,0)= 5._RPP/16._RPP ! stencil 0 + c(1,0,1)= -1._RPP/16._RPP; c(1,1,1)= 9._RPP/16._RPP; c(1,2,1)= 9._RPP/16._RPP; c(1,3,1)= -1._RPP/16._RPP ! stencil 1 + c(1,0,2)= 5._RPP/16._RPP; c(1,1,2)= 15._RPP/16._RPP; c(1,2,2)= -5._RPP/16._RPP; c(1,3,2)= 1._RPP/16._RPP ! stencil 2 + c(1,0,3)= 35._RPP/16._RPP; c(1,1,3)=-35._RPP/16._RPP; c(1,2,3)= 21._RPP/16._RPP; c(1,3,3)= -5._RPP/16._RPP ! stencil 3 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(2,0,0)= -5._RPP/16._RPP; c(2,1,0)= 21._RPP/16._RPP; c(2,2,0)=-35._RPP/16._RPP; c(2,3,0)= 35._RPP/16._RPP ! stencil 0 + c(2,0,1)= 1._RPP/16._RPP; c(2,1,1)= -5._RPP/16._RPP; c(2,2,1)= 15._RPP/16._RPP; c(2,3,1)= 5._RPP/16._RPP ! stencil 1 + c(2,0,2)= -1._RPP/16._RPP; c(2,1,2)= 9._RPP/16._RPP; c(2,2,2)= 9._RPP/16._RPP; c(2,3,2)= -1._RPP/16._RPP ! stencil 2 + c(2,0,3)= 5._RPP/16._RPP; c(2,1,3)= 15._RPP/16._RPP; c(2,2,3)= -5._RPP/16._RPP; c(2,3,3)= 1._RPP/16._RPP ! stencil 3 + case(5) ! 9th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(1,0,0)= -5._RPP/128._RPP; c(1,1,0)= 7._RPP/32._RPP ; c(1,2,0)= -35._RPP/64._RPP ; c(1,3,0)= 35._RPP/32._RPP ! stencil 0 + c(1,0,1)= 3._RPP/128._RPP; c(1,1,1)= -5._RPP/32._RPP ; c(1,2,1)= 45._RPP/64._RPP ; c(1,3,1)= 15._RPP/32._RPP ! stencil 1 + c(1,0,2)= -5._RPP/128._RPP; c(1,1,2)= 15._RPP/32._RPP ; c(1,2,2)= 45._RPP/64._RPP ; c(1,3,2)= -5._RPP/32._RPP ! stencil 2 + c(1,0,3)= 35._RPP/128._RPP; c(1,1,3)= 35._RPP/32._RPP ; c(1,2,3)= -35._RPP/64._RPP ; c(1,3,3)= 7._RPP/32._RPP ! stencil 3 + c(1,0,4)= 315._RPP/128._RPP; c(1,1,4)=-105._RPP/32._RPP ; c(1,2,4)= 189._RPP/64._RPP ; c(1,3,4)= -45._RPP/32._RPP ! stencil 4 + ! cell 4 + c(1,4,0)= 35._RPP/128._RPP ! stencil 0 + c(1,4,1)= -5._RPP/128._RPP ! stencil 1 + c(1,4,2)= 3._RPP/128._RPP ! stencil 2 + c(1,4,3)= -5._RPP/128._RPP ! stencil 3 + c(1,4,4)= 35._RPP/128._RPP ! stencil 4 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(2,0,0)= 35._RPP/128._RPP; c(2,1,0)= -45._RPP/32._RPP ; c(2,2,0)= 189._RPP/64._RPP ; c(2,3,0)=-105._RPP/32._RPP ! stencil 0 + c(2,0,1)= -5._RPP/128._RPP; c(2,1,1)= 7._RPP/32._RPP ; c(2,2,1)= -35._RPP/64._RPP ; c(2,3,1)= 35._RPP/32._RPP ! stencil 1 + c(2,0,2)= 3._RPP/128._RPP; c(2,1,2)= -5._RPP/32._RPP ; c(2,2,2)= 45._RPP/64._RPP ; c(2,3,2)= 15._RPP/32._RPP ! stencil 2 + c(2,0,3)= -5._RPP/128._RPP; c(2,1,3)= 15._RPP/32._RPP ; c(2,2,3)= 45._RPP/64._RPP ; c(2,3,3)= -5._RPP/32._RPP ! stencil 3 + c(2,0,4)= 35._RPP/128._RPP; c(2,1,4)= 35._RPP/32._RPP ; c(2,2,4)= -35._RPP/64._RPP ; c(2,3,4)= 7._RPP/32._RPP ! stencil 4 + ! cell 4 + c(2,4,0)= 315._RPP/128._RPP ! stencil 0 + c(2,4,1)= 35._RPP/128._RPP ! stencil 1 + c(2,4,2)= -5._RPP/128._RPP ! stencil 2 + c(2,4,3)= 3._RPP/128._RPP ! stencil 3 + c(2,4,4)= -5._RPP/128._RPP ! stencil 4 + case(6) ! 11th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(1,0,0)= 7._RPP/256._RPP; c(1,1,0)= -45._RPP/256._RPP; c(1,2,0)= 63._RPP/128._RPP; c(1,3,0)= -105._RPP/128._RPP ! stencil 0 + c(1,0,1)= -3._RPP/256._RPP; c(1,1,1)= 21._RPP/256._RPP; c(1,2,1)= -35._RPP/128._RPP; c(1,3,1)= 105._RPP/128._RPP ! stencil 1 + c(1,0,2)= 3._RPP/256._RPP; c(1,1,2)= -25._RPP/256._RPP; c(1,2,2)= 75._RPP/128._RPP; c(1,3,2)= 75._RPP/128._RPP ! stencil 2 + c(1,0,3)= -7._RPP/256._RPP; c(1,1,3)= 105._RPP/256._RPP; c(1,2,3)= 105._RPP/128._RPP; c(1,3,3)= -35._RPP/128._RPP ! stencil 3 + c(1,0,4)= 63._RPP/256._RPP; c(1,1,4)= 315._RPP/256._RPP; c(1,2,4)= -105._RPP/128._RPP; c(1,3,4)= 63._RPP/128._RPP ! stencil 4 + c(1,0,5)= 693._RPP/256._RPP; c(1,1,5)=-1155._RPP/256._RPP; c(1,2,5)= 693._RPP/128._RPP; c(1,3,5)= -495._RPP/128._RPP ! stencil 5 + ! cell 4 ; cell 5 + c(1,4,0)= 315._RPP/256._RPP; c(1,5,0)= 63._RPP/256._RPP ! stencil 0 + c(1,4,1)= 105._RPP/256._RPP; c(1,5,1)= -7._RPP/256._RPP ! stencil 1 + c(1,4,2)= -25._RPP/256._RPP; c(1,5,2)= 3._RPP/256._RPP ! stencil 2 + c(1,4,3)= 21._RPP/256._RPP; c(1,5,3)= -3._RPP/256._RPP ! stencil 3 + c(1,4,4)= -45._RPP/256._RPP; c(1,5,4)= 7._RPP/256._RPP ! stencil 4 + c(1,4,5)= 385._RPP/256._RPP; c(1,5,5)= -63._RPP/256._RPP ! stencil 5 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(2,0,0)= -63._RPP/256._RPP; c(2,1,0)= 385._RPP/256._RPP; c(2,2,0)= -495._RPP/128._RPP; c(2,3,0)= 693._RPP/128._RPP ! stencil 0 + c(2,0,1)= 7._RPP/256._RPP; c(2,1,1)= -45._RPP/256._RPP; c(2,2,1)= 63._RPP/128._RPP; c(2,3,1)= -105._RPP/128._RPP ! stencil 1 + c(2,0,2)= -3._RPP/256._RPP; c(2,1,2)= 21._RPP/256._RPP; c(2,2,2)= -35._RPP/128._RPP; c(2,3,2)= 105._RPP/128._RPP ! stencil 2 + c(2,0,3)= 3._RPP/256._RPP; c(2,1,3)= -25._RPP/256._RPP; c(2,2,3)= 75._RPP/128._RPP; c(2,3,3)= 75._RPP/128._RPP ! stencil 3 + c(2,0,4)= -7._RPP/256._RPP; c(2,1,4)= 105._RPP/256._RPP; c(2,2,4)= 105._RPP/128._RPP; c(2,3,4)= -35._RPP/128._RPP ! stencil 4 + c(2,0,5)= 63._RPP/256._RPP; c(2,1,5)= 315._RPP/256._RPP; c(2,2,5)= -105._RPP/128._RPP; c(2,3,5)= 63._RPP/128._RPP ! stencil 5 + ! cell 4 ; cell 5 + c(2,4,0)=-1155._RPP/256._RPP; c(2,5,0)= 693._RPP/256._RPP ! stencil 0 + c(2,4,1)= 315._RPP/256._RPP; c(2,5,1)= 63._RPP/256._RPP ! stencil 1 + c(2,4,2)= 105._RPP/256._RPP; c(2,5,2)= -7._RPP/256._RPP ! stencil 2 + c(2,4,3)= -25._RPP/256._RPP; c(2,5,3)= 3._RPP/256._RPP ! stencil 3 + c(2,4,4)= 21._RPP/256._RPP; c(2,5,4)= -3._RPP/256._RPP ! stencil 4 + c(2,4,5)= -45._RPP/256._RPP; c(2,5,5)= 7._RPP/256._RPP ! stencil 5 + case(7) ! 13th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 + c(1,0,0)= -21._RPP/1024._RPP; c(1,1,0)= 77._RPP/512._RPP ; c(1,2,0)= -495._RPP/1024._RPP ! stencil 0 + c(1,0,1)= 7._RPP/1024._RPP; c(1,1,1)= -27._RPP/512._RPP ; c(1,2,1)= 189._RPP/1024._RPP ! stencil 1 + c(1,0,2)= -5._RPP/1024._RPP; c(1,1,2)= 21._RPP/512._RPP ; c(1,2,2)= -175._RPP/1024._RPP ! stencil 2 + c(1,0,3)= 7._RPP/1024._RPP; c(1,1,3)= -35._RPP/512._RPP ; c(1,2,3)= 525._RPP/1024._RPP ! stencil 3 + c(1,0,4)= -21._RPP/1024._RPP; c(1,1,4)= 189._RPP/512._RPP ; c(1,2,4)= 945._RPP/1024._RPP ! stencil 4 + c(1,0,5)= 231._RPP/1024._RPP; c(1,1,5)= 693._RPP/512._RPP ; c(1,2,5)=-1155._RPP/1024._RPP ! stencil 5 + c(1,0,6)= 3003._RPP/1024._RPP; c(1,1,6)=-3003._RPP/512._RPP ; c(1,2,6)= 9009._RPP/1024._RPP ! stencil 6 + ! cell 3 cell 4 ; cell 5 + c(1,3,0)= 231._RPP/256._RPP ; c(1,4,0)=-1155._RPP/1024._RPP; c(1,5,0)= 693._RPP/512._RPP ! stencil 0 + c(1,3,1)= -105._RPP/256._RPP ; c(1,4,1)= 945._RPP/1024._RPP; c(1,5,1)= 189._RPP/512._RPP ! stencil 1 + c(1,3,2)= 175._RPP/256._RPP ; c(1,4,2)= 525._RPP/1024._RPP; c(1,5,2)= -35._RPP/512._RPP ! stencil 2 + c(1,3,3)= 175._RPP/256._RPP ; c(1,4,3)= -175._RPP/1024._RPP; c(1,5,3)= 21._RPP/512._RPP ! stencil 3 + c(1,3,4)= -105._RPP/256._RPP ; c(1,4,4)= 189._RPP/1024._RPP; c(1,5,4)= -27._RPP/512._RPP ! stencil 4 + c(1,3,5)= 231._RPP/256._RPP ; c(1,4,5)= -495._RPP/1024._RPP; c(1,5,5)= 77._RPP/512._RPP ! stencil 5 + c(1,3,6)=-2145._RPP/256._RPP ; c(1,4,6)= 5005._RPP/1024._RPP; c(1,5,6)= -819._RPP/512._RPP ! stencil 6 + ! cell 6 + c(1,6,0)= 231._RPP/1024._RPP ! stencil 0 + c(1,6,1)= -21._RPP/1024._RPP ! stencil 1 + c(1,6,2)= 7._RPP/1024._RPP ! stencil 2 + c(1,6,3)= -5._RPP/1024._RPP ! stencil 3 + c(1,6,4)= 7._RPP/1024._RPP ! stencil 4 + c(1,6,5)= -21._RPP/1024._RPP ! stencil 5 + c(1,6,6)= 231._RPP/1024._RPP ! stencil 6 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 + c(2,0,0)= 231._RPP/1024._RPP; c(2,1,0)= -819._RPP/512._RPP ; c(2,2,0)= 5005._RPP/1024._RPP ! stencil 0 + c(2,0,1)= -21._RPP/1024._RPP; c(2,1,1)= 77._RPP/512._RPP ; c(2,2,1)= -495._RPP/1024._RPP ! stencil 1 + c(2,0,2)= 7._RPP/1024._RPP; c(2,1,2)= -27._RPP/512._RPP ; c(2,2,2)= 189._RPP/1024._RPP ! stencil 2 + c(2,0,3)= -5._RPP/1024._RPP; c(2,1,3)= 21._RPP/512._RPP ; c(2,2,3)= -175._RPP/1024._RPP ! stencil 3 + c(2,0,4)= 7._RPP/1024._RPP; c(2,1,4)= -35._RPP/512._RPP ; c(2,2,4)= 525._RPP/1024._RPP ! stencil 4 + c(2,0,5)= -21._RPP/1024._RPP; c(2,1,5)= 189._RPP/512._RPP ; c(2,2,5)= 945._RPP/1024._RPP ! stencil 5 + c(2,0,6)= 231._RPP/1024._RPP; c(2,1,6)= 693._RPP/512._RPP ; c(2,2,6)=-1155._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(2,3,0)=-2145._RPP/256._RPP ; c(2,4,0)= 9009._RPP/1024._RPP; c(2,5,0)=-3003._RPP/512._RPP ! stencil 0 + c(2,3,1)= 231._RPP/256._RPP ; c(2,4,1)=-1155._RPP/1024._RPP; c(2,5,1)= 693._RPP/512._RPP ! stencil 1 + c(2,3,2)= -105._RPP/256._RPP ; c(2,4,2)= 945._RPP/1024._RPP; c(2,5,2)= 189._RPP/512._RPP ! stencil 2 + c(2,3,3)= 175._RPP/256._RPP ; c(2,4,3)= 525._RPP/1024._RPP; c(2,5,3)= -35._RPP/512._RPP ! stencil 3 + c(2,3,4)= 175._RPP/256._RPP ; c(2,4,4)= -175._RPP/1024._RPP; c(2,5,4)= 21._RPP/512._RPP ! stencil 4 + c(2,3,5)= -105._RPP/256._RPP ; c(2,4,5)= 189._RPP/1024._RPP; c(2,5,5)= -27._RPP/512._RPP ! stencil 5 + c(2,3,6)= 231._RPP/256._RPP ; c(2,4,6)= -495._RPP/1024._RPP; c(2,5,6)= 77._RPP/512._RPP ! stencil 6 + ! cell 6 + c(2,6,0)= 3003._RPP/1024._RPP ! stencil 0 + c(2,6,1)= 231._RPP/1024._RPP ! stencil 1 + c(2,6,2)= -21._RPP/1024._RPP ! stencil 2 + c(2,6,3)= 7._RPP/1024._RPP ! stencil 3 + c(2,6,4)= -5._RPP/1024._RPP ! stencil 4 + c(2,6,5)= 7._RPP/1024._RPP ! stencil 5 + c(2,6,6)= -21._RPP/1024._RPP ! stencil 6 + case(8) ! 15th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 + c(1,0,0)= 33._RPP/2048._RPP; c(1,1,0)= -273._RPP/2048._RPP; c(1,2,0)= 1001._RPP/2048._RPP ! stencil 0 + c(1,0,1)= -9._RPP/2048._RPP; c(1,1,1)= 77._RPP/2048._RPP; c(1,2,1)= -297._RPP/2048._RPP ! stencil 1 + c(1,0,2)= 5._RPP/2048._RPP; c(1,1,2)= -45._RPP/2048._RPP; c(1,2,2)= 189._RPP/2048._RPP ! stencil 2 + c(1,0,3)= -5._RPP/2048._RPP; c(1,1,3)= 49._RPP/2048._RPP; c(1,2,3)= -245._RPP/2048._RPP ! stencil 3 + c(1,0,4)= 9._RPP/2048._RPP; c(1,1,4)= -105._RPP/2048._RPP; c(1,2,4)= 945._RPP/2048._RPP ! stencil 4 + c(1,0,5)= -33._RPP/2048._RPP; c(1,1,5)= 693._RPP/2048._RPP; c(1,2,5)= 2079._RPP/2048._RPP ! stencil 5 + c(1,0,6)= 429._RPP/2048._RPP; c(1,1,6)= 3003._RPP/2048._RPP; c(1,2,6)= -3003._RPP/2048._RPP ! stencil 6 + c(1,0,7)= 6435._RPP/2048._RPP; c(1,1,7)=-15015._RPP/2048._RPP; c(1,2,7)= 27027._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(1,3,0)= -2145._RPP/2048._RPP; c(1,4,0)= 3003._RPP/2048._RPP; c(1,5,0)= -3003._RPP/2048._RPP ! stencil 0 + c(1,3,1)= 693._RPP/2048._RPP; c(1,4,1)= -1155._RPP/2048._RPP; c(1,5,1)= 2079._RPP/2048._RPP ! stencil 1 + c(1,3,2)= -525._RPP/2048._RPP; c(1,4,2)= 1575._RPP/2048._RPP; c(1,5,2)= 945._RPP/2048._RPP ! stencil 2 + c(1,3,3)= 1225._RPP/2048._RPP; c(1,4,3)= 1225._RPP/2048._RPP; c(1,5,3)= -245._RPP/2048._RPP ! stencil 3 + c(1,3,4)= 1575._RPP/2048._RPP; c(1,4,4)= -525._RPP/2048._RPP; c(1,5,4)= 189._RPP/2048._RPP ! stencil 4 + c(1,3,5)= -1155._RPP/2048._RPP; c(1,4,5)= 693._RPP/2048._RPP; c(1,5,5)= -297._RPP/2048._RPP ! stencil 5 + c(1,3,6)= 3003._RPP/2048._RPP; c(1,4,6)= -2145._RPP/2048._RPP; c(1,5,6)= 1001._RPP/2048._RPP ! stencil 6 + c(1,3,7)=-32175._RPP/2048._RPP; c(1,4,7)= 25025._RPP/2048._RPP; c(1,5,7)=-12285._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(1,6,0)= 3003._RPP/2048._RPP; c(1,7,0)= 429._RPP/2048._RPP ! stencil 0 + c(1,6,1)= 693._RPP/2048._RPP; c(1,7,1)= -33._RPP/2048._RPP ! stencil 1 + c(1,6,2)= -105._RPP/2048._RPP; c(1,7,2)= 9._RPP/2048._RPP ! stencil 2 + c(1,6,3)= 49._RPP/2048._RPP; c(1,7,3)= -5._RPP/2048._RPP ! stencil 3 + c(1,6,4)= -45._RPP/2048._RPP; c(1,7,4)= 5._RPP/2048._RPP ! stencil 4 + c(1,6,5)= 77._RPP/2048._RPP; c(1,7,5)= -9._RPP/2048._RPP ! stencil 5 + c(1,6,6)= -273._RPP/2048._RPP; c(1,7,6)= 33._RPP/2048._RPP ! stencil 6 + c(1,6,7)= 3465._RPP/2048._RPP; c(1,7,7)= -429._RPP/2048._RPP ! stencil 7 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 + c(2,0,0)= -429._RPP/2048._RPP; c(2,1,0)= 3465._RPP/2048._RPP; c(2,2,0)=-12285._RPP/2048._RPP ! stencil 0 + c(2,0,1)= 33._RPP/2048._RPP; c(2,1,1)= -273._RPP/2048._RPP; c(2,2,1)= 1001._RPP/2048._RPP ! stencil 1 + c(2,0,2)= -9._RPP/2048._RPP; c(2,1,2)= 77._RPP/2048._RPP; c(2,2,2)= -297._RPP/2048._RPP ! stencil 2 + c(2,0,3)= 5._RPP/2048._RPP; c(2,1,3)= -45._RPP/2048._RPP; c(2,2,3)= 189._RPP/2048._RPP ! stencil 3 + c(2,0,4)= -5._RPP/2048._RPP; c(2,1,4)= 49._RPP/2048._RPP; c(2,2,4)= -245._RPP/2048._RPP ! stencil 4 + c(2,0,5)= 9._RPP/2048._RPP; c(2,1,5)= -105._RPP/2048._RPP; c(2,2,5)= 945._RPP/2048._RPP ! stencil 5 + c(2,0,6)= -33._RPP/2048._RPP; c(2,1,6)= 693._RPP/2048._RPP; c(2,2,6)= 2079._RPP/2048._RPP ! stencil 6 + c(2,0,7)= 429._RPP/2048._RPP; c(2,1,7)= 3003._RPP/2048._RPP; c(2,2,7)= -3003._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(2,3,0)= 25025._RPP/2048._RPP; c(2,4,0)=-32175._RPP/2048._RPP; c(2,5,0)= 27027._RPP/2048._RPP ! stencil 0 + c(2,3,1)= -2145._RPP/2048._RPP; c(2,4,1)= 3003._RPP/2048._RPP; c(2,5,1)= -3003._RPP/2048._RPP ! stencil 1 + c(2,3,2)= 693._RPP/2048._RPP; c(2,4,2)= -1155._RPP/2048._RPP; c(2,5,2)= 2079._RPP/2048._RPP ! stencil 2 + c(2,3,3)= -525._RPP/2048._RPP; c(2,4,3)= 1575._RPP/2048._RPP; c(2,5,3)= 945._RPP/2048._RPP ! stencil 3 + c(2,3,4)= 1225._RPP/2048._RPP; c(2,4,4)= 1225._RPP/2048._RPP; c(2,5,4)= -245._RPP/2048._RPP ! stencil 4 + c(2,3,5)= 1575._RPP/2048._RPP; c(2,4,5)= -525._RPP/2048._RPP; c(2,5,5)= 189._RPP/2048._RPP ! stencil 5 + c(2,3,6)= -1155._RPP/2048._RPP; c(2,4,6)= 693._RPP/2048._RPP; c(2,5,6)= -297._RPP/2048._RPP ! stencil 6 + c(2,3,7)= 3003._RPP/2048._RPP; c(2,4,7)= -2145._RPP/2048._RPP; c(2,5,7)= 1001._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(2,6,0)=-15015._RPP/2048._RPP; c(2,7,0)= 6435._RPP/2048._RPP ! stencil 0 + c(2,6,1)= 3003._RPP/2048._RPP; c(2,7,1)= 429._RPP/2048._RPP ! stencil 1 + c(2,6,2)= 693._RPP/2048._RPP; c(2,7,2)= -33._RPP/2048._RPP ! stencil 2 + c(2,6,3)= -105._RPP/2048._RPP; c(2,7,3)= 9._RPP/2048._RPP ! stencil 3 + c(2,6,4)= 49._RPP/2048._RPP; c(2,7,4)= -5._RPP/2048._RPP ! stencil 4 + c(2,6,5)= -45._RPP/2048._RPP; c(2,7,5)= 5._RPP/2048._RPP ! stencil 5 + c(2,6,6)= 77._RPP/2048._RPP; c(2,7,6)= -9._RPP/2048._RPP ! stencil 6 + c(2,6,7)= -273._RPP/2048._RPP; c(2,7,7)= 33._RPP/2048._RPP ! stencil 7 + case(9) ! 17th order + ! 1 => left interface (i-1/2) + ! cell 0 ; cell 1 ; cell 2 + c(1,0,0)= -429._RPP/32768._RPP; c(1,1,0)= 495._RPP/4096._RPP ; c(1,2,0)= -4095._RPP/8192._RPP ! stencil 0 + c(1,0,1)= 99._RPP/32768._RPP; c(1,1,1)= -117._RPP/4096._RPP ; c(1,2,1)= 1001._RPP/8192._RPP ! stencil 1 + c(1,0,2)= -45._RPP/32768._RPP; c(1,1,2)= 55._RPP/4096._RPP ; c(1,2,2)= -495._RPP/8192._RPP ! stencil 2 + c(1,0,3)= 35._RPP/32768._RPP; c(1,1,3)= -45._RPP/4096._RPP ; c(1,2,3)= 441._RPP/8192._RPP ! stencil 3 + c(1,0,4)= -45._RPP/32768._RPP; c(1,1,4)= 63._RPP/4096._RPP ; c(1,2,4)= -735._RPP/8192._RPP ! stencil 4 + c(1,0,5)= 99._RPP/32768._RPP; c(1,1,5)= -165._RPP/4096._RPP ; c(1,2,5)= 3465._RPP/8192._RPP ! stencil 5 + c(1,0,6)= -429._RPP/32768._RPP; c(1,1,6)= 1287._RPP/4096._RPP ; c(1,2,6)= 9009._RPP/8192._RPP ! stencil 6 + c(1,0,7)= 6435._RPP/32768._RPP; c(1,1,7)= 6435._RPP/4096._RPP ; c(1,2,7)= -15015._RPP/8192._RPP ! stencil 7 + c(1,0,8)= 109395._RPP/32768._RPP; c(1,1,8)= -36465._RPP/4096._RPP ; c(1,2,8)= 153153._RPP/8192._RPP ! stencil 8 + ! cell 3 ; cell 4 ; cell 5 + c(1,3,0)= 5005._RPP/4096._RPP ; c(1,4,0)= -32175._RPP/16384._RPP; c(1,5,0)= 9009._RPP/4096._RPP ! stencil 0 + c(1,3,1)= -1287._RPP/4096._RPP ; c(1,4,1)= 9009._RPP/16384._RPP; c(1,5,1)= -3003._RPP/4096._RPP ! stencil 1 + c(1,3,2)= 693._RPP/4096._RPP ; c(1,4,2)= -5775._RPP/16384._RPP; c(1,5,2)= 3465._RPP/4096._RPP ! stencil 2 + c(1,3,3)= -735._RPP/4096._RPP ; c(1,4,3)= 11025._RPP/16384._RPP; c(1,5,3)= 2205._RPP/4096._RPP ! stencil 3 + c(1,3,4)= 2205._RPP/4096._RPP ; c(1,4,4)= 11025._RPP/16384._RPP; c(1,5,4)= -735._RPP/4096._RPP ! stencil 4 + c(1,3,5)= 3465._RPP/4096._RPP ; c(1,4,5)= -5775._RPP/16384._RPP; c(1,5,5)= 693._RPP/4096._RPP ! stencil 5 + c(1,3,6)= -3003._RPP/4096._RPP ; c(1,4,6)= 9009._RPP/16384._RPP; c(1,5,6)= -1287._RPP/4096._RPP ! stencil 6 + c(1,3,7)= 9009._RPP/4096._RPP ; c(1,4,7)= -32175._RPP/16384._RPP; c(1,5,7)= 5005._RPP/4096._RPP ! stencil 7 + c(1,3,8)=-109395._RPP/4096._RPP ; c(1,4,8)= 425425._RPP/16384._RPP; c(1,5,8)= -69615._RPP/4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(1,6,0)= -15015._RPP/8192._RPP ; c(1,7,0)= 6435._RPP/4096._RPP ; c(1,8,0)= 6435._RPP/32768._RPP ! stencil 0 + c(1,6,1)= 9009._RPP/8192._RPP ; c(1,7,1)= 1287._RPP/4096._RPP ; c(1,8,1)= -429._RPP/32768._RPP ! stencil 1 + c(1,6,2)= 3465._RPP/8192._RPP ; c(1,7,2)= -165._RPP/4096._RPP ; c(1,8,2)= 99._RPP/32768._RPP ! stencil 2 + c(1,6,3)= -735._RPP/8192._RPP ; c(1,7,3)= 63._RPP/4096._RPP ; c(1,8,3)= -45._RPP/32768._RPP ! stencil 3 + c(1,6,4)= 441._RPP/8192._RPP ; c(1,7,4)= -45._RPP/4096._RPP ; c(1,8,4)= 35._RPP/32768._RPP ! stencil 4 + c(1,6,5)= -495._RPP/8192._RPP ; c(1,7,5)= 55._RPP/4096._RPP ; c(1,8,5)= -45._RPP/32768._RPP ! stencil 5 + c(1,6,6)= 1001._RPP/8192._RPP ; c(1,7,6)= -117._RPP/4096._RPP ; c(1,8,6)= 99._RPP/32768._RPP ! stencil 6 + c(1,6,7)= -4095._RPP/8192._RPP ; c(1,7,7)= 495._RPP/4096._RPP ; c(1,8,7)= -429._RPP/32768._RPP ! stencil 7 + c(1,6,8)= 58905._RPP/8192._RPP ; c(1,7,8)= -7293._RPP/4096._RPP ; c(1,8,8)= 6435._RPP/32768._RPP ! stencil 8 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 + c(2,0,0)= 6435._RPP/32768._RPP; c(2,1,0)= -7293._RPP/ 4096._RPP; c(2,2,0)= 58905._RPP/ 8192._RPP ! stencil 0 + c(2,0,1)= -429._RPP/32768._RPP; c(2,1,1)= 495._RPP/ 4096._RPP; c(2,2,1)= -4095._RPP/ 8192._RPP ! stencil 1 + c(2,0,2)= 99._RPP/32768._RPP; c(2,1,2)= -117._RPP/ 4096._RPP; c(2,2,2)= 1001._RPP/ 8192._RPP ! stencil 2 + c(2,0,3)= -45._RPP/32768._RPP; c(2,1,3)= 55._RPP/ 4096._RPP; c(2,2,3)= -495._RPP/ 8192._RPP ! stencil 3 + c(2,0,4)= 35._RPP/32768._RPP; c(2,1,4)= -45._RPP/ 4096._RPP; c(2,2,4)= 441._RPP/ 8192._RPP ! stencil 4 + c(2,0,5)= -45._RPP/32768._RPP; c(2,1,5)= 63._RPP/ 4096._RPP; c(2,2,5)= -735._RPP/ 8192._RPP ! stencil 5 + c(2,0,6)= 99._RPP/32768._RPP; c(2,1,6)= -165._RPP/ 4096._RPP; c(2,2,6)= 3465._RPP/ 8192._RPP ! stencil 6 + c(2,0,7)= -429._RPP/32768._RPP; c(2,1,7)= 1287._RPP/ 4096._RPP; c(2,2,7)= 9009._RPP/ 8192._RPP ! stencil 7 + c(2,0,8)= 6435._RPP/32768._RPP; c(2,1,8)= 6435._RPP/ 4096._RPP; c(2,2,8)= -15015._RPP/ 8192._RPP ! stencil 8 + ! cell 3 ; ! cell 4 ; cell 5 + c(2,3,0)= -69615._RPP/ 4096._RPP; c(2,4,0)= 425425._RPP/16384._RPP; c(2,5,0)=-109395._RPP/ 4096._RPP ! stencil 0 + c(2,3,1)= 5005._RPP/ 4096._RPP; c(2,4,1)= -32175._RPP/16384._RPP; c(2,5,1)= 9009._RPP/ 4096._RPP ! stencil 1 + c(2,3,2)= -1287._RPP/ 4096._RPP; c(2,4,2)= 9009._RPP/16384._RPP; c(2,5,2)= -3003._RPP/ 4096._RPP ! stencil 2 + c(2,3,3)= 693._RPP/ 4096._RPP; c(2,4,3)= -5775._RPP/16384._RPP; c(2,5,3)= 3465._RPP/ 4096._RPP ! stencil 3 + c(2,3,4)= -735._RPP/ 4096._RPP; c(2,4,4)= 11025._RPP/16384._RPP; c(2,5,4)= 2205._RPP/ 4096._RPP ! stencil 4 + c(2,3,5)= 2205._RPP/ 4096._RPP; c(2,4,5)= 11025._RPP/16384._RPP; c(2,5,5)= -735._RPP/ 4096._RPP ! stencil 5 + c(2,3,6)= 3465._RPP/ 4096._RPP; c(2,4,6)= -5775._RPP/16384._RPP; c(2,5,6)= 693._RPP/ 4096._RPP ! stencil 6 + c(2,3,7)= -3003._RPP/ 4096._RPP; c(2,4,7)= 9009._RPP/16384._RPP; c(2,5,7)= -1287._RPP/ 4096._RPP ! stencil 7 + c(2,3,8)= 9009._RPP/ 4096._RPP; c(2,4,8)= -32175._RPP/16384._RPP; c(2,5,8)= 5005._RPP/ 4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(2,6,0)= 153153._RPP/ 8192._RPP; c(2,7,0)= -36465._RPP/ 4096._RPP; c(2,8,0)= 109395._RPP/32768._RPP ! stencil 0 + c(2,6,1)= -15015._RPP/ 8192._RPP; c(2,7,1)= 6435._RPP/ 4096._RPP; c(2,8,1)= 6435._RPP/32768._RPP ! stencil 1 + c(2,6,2)= 9009._RPP/ 8192._RPP; c(2,7,2)= 1287._RPP/ 4096._RPP; c(2,8,2)= -429._RPP/32768._RPP ! stencil 2 + c(2,6,3)= 3465._RPP/ 8192._RPP; c(2,7,3)= -165._RPP/ 4096._RPP; c(2,8,3)= 99._RPP/32768._RPP ! stencil 3 + c(2,6,4)= -735._RPP/ 8192._RPP; c(2,7,4)= 63._RPP/ 4096._RPP; c(2,8,4)= -45._RPP/32768._RPP ! stencil 4 + c(2,6,5)= 441._RPP/ 8192._RPP; c(2,7,5)= -45._RPP/ 4096._RPP; c(2,8,5)= 35._RPP/32768._RPP ! stencil 5 + c(2,6,6)= -495._RPP/ 8192._RPP; c(2,7,6)= 55._RPP/ 4096._RPP; c(2,8,6)= -45._RPP/32768._RPP ! stencil 6 + c(2,6,7)= 1001._RPP/ 8192._RPP; c(2,7,7)= -117._RPP/ 4096._RPP; c(2,8,7)= 99._RPP/32768._RPP ! stencil 7 + c(2,6,8)= -4095._RPP/ 8192._RPP; c(2,7,8)= 495._RPP/ 4096._RPP; c(2,8,8)= -429._RPP/32768._RPP ! stencil 8 + endselect + endassociate + endsubroutine create + + pure subroutine compute(self, stencil) + !< Compute interpolations. + class(interpolations_int_js), intent(inout) :: self !< Interpolations. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + integer(I_P) :: s1 !< Counter. + integer(I_P) :: s2 !< Counter. + integer(I_P) :: f !< Counter. + + self%values = 0._RPP + do s1=0, self%S - 1 ! stencils loop + do s2=0, self%S - 1 ! values loop + do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + self%values(f, s1) = self%values(f, s1) + self%coef(f, s2, s1) * stencil(f + self%ff, -s2 + s1) + enddo + enddo + enddo + endsubroutine compute + + pure function description(self) result(string) + !< Return interpolations string-description. + class(interpolations_int_js), intent(in) :: self !< Interpolations. + character(len=:), allocatable :: string !< String-description. + +#ifndef DEBUG + ! error stop in pure procedure is a F2015 feature not yet supported in debug mode + error stop 'interpolations_int_js%description to be implemented, do not use!' +#endif + endfunction description + + elemental subroutine destroy(self) + !< Destroy interpolations. + class(interpolations_int_js), intent(inout) :: self !< Interpolations. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + if (allocated(self%coef)) deallocate(self%coef) + endsubroutine destroy +endmodule wenoof_interpolations_int_js From d86c89df018d92779e4cda5816faba67f2652445 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 1 Feb 2017 10:35:56 +0100 Subject: [PATCH 02/90] Added kappa coefficients Short description Why: * This change addresses the need by: * Side effects: * --- .../concrete_objects/wenoof_kappa_int_js.F90 | 196 ++++++++++++++++++ 1 file changed, 196 insertions(+) create mode 100644 src/lib/concrete_objects/wenoof_kappa_int_js.F90 diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 new file mode 100644 index 0000000..0362a88 --- /dev/null +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -0,0 +1,196 @@ +!< Jiang-Shu and Gerolymos-Senechal-Vallet kappa coefficients for interpolation. +module wenoof_kappa_int_js +!< Jiang-Shu and Gerolymos-Senechal-Vallet kappa coefficients for interpolation. +!< +!< @note The provided WENO kappa implements the linear weights defined in *High Order Weighted Essentially +!< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, +!< doi:10.1137/070679065. + +#ifdef r16p +use penf, only: I_P, RPP=>R16P +#else +use penf, only: I_P, RPP=>R8P +#endif +use wenoof_base_object +use wenoof_kappa_object + +implicit none +private +public :: kappa_int_js +public :: kappa_int_js_constructor + +type, extends(kappa_object_constructor) :: kappa_int_js_constructor + !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal kappa object constructor. +endtype kappa_int_js_constructor + +type, extends(kappa_object):: kappa_int_js + !< Jiang-Shu and Gerolymos-Senechal-Vallet kappa object. + !< + !< @note The provided WENO kappa implements the linear weights defined in *High Order Weighted Essentially + !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, + !< doi:10.1137/070679065. + contains + ! public deferred methods + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. +endtype kappa_int_js + +contains + ! deferred public methods + subroutine create(self, constructor) + !< Create kappa. + !< + !< @note The kappa coefficients are also computed, they being constants. + class(kappa_int_js), intent(inout) :: self !< Kappa. + class(base_object_constructor), intent(in) :: constructor !< Kappa constructor. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(1:2, 0:self%S - 1)) + self%values = 0._RPP + call self%compute + endsubroutine create + + pure subroutine compute(self) + !< Compute kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. + + associate(val => self%values) + select case(self%S) + case(2) ! 3rd order + ! 1 => left interface (i-1/2) + val(1, 0) = 3._RPP/4._RPP ! stencil 0 + val(1, 1) = 1._RPP/4._RPP ! stencil 1 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/4._RPP ! stencil 0 + val(2, 1) = 3._RPP/4._RPP ! stencil 1 + case(3) ! 5th order + ! 1 => left interface (i-1/2) + val(1, 0) = 5._RPP/16._RPP ! stencil 0 + val(1, 1) = 5._RPP/8._RPP ! stencil 1 + val(1, 2) = 1._RPP/16._RPP ! stencil 2 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/16._RPP ! stencil 0 + val(2, 1) = 5._RPP/8._RPP ! stencil 1 + val(2, 2) = 5._RPP/16._RPP ! stencil 2 + case(4) ! 7th order + ! 1 => left interface (i-1/2) + val(1, 0) = 7._RPP/64._RPP ! stencil 0 + val(1, 1) = 35._RPP/64._RPP ! stencil 1 + val(1, 2) = 21._RPP/64._RPP ! stencil 2 + val(1, 3) = 1._RPP/64._RPP ! stencil 3 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/64._RPP ! stencil 0 + val(2, 1) = 21._RPP/64._RPP ! stencil 1 + val(2, 2) = 35._RPP/64._RPP ! stencil 2 + val(2, 3) = 7._RPP/64._RPP ! stencil 3 + case(5) ! 9th order + ! 1 => left interface (i-1/2) + val(1, 0) = 9._RPP/256._RPP ! stencil 0 + val(1, 1) = 21._RPP/64._RPP ! stencil 1 + val(1, 2) = 63._RPP/128._RPP ! stencil 2 + val(1, 3) = 9._RPP/64._RPP ! stencil 3 + val(1, 4) = 1._RPP/256._RPP ! stencil 4 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/256._RPP ! stencil 0 + val(2, 1) = 9._RPP/64._RPP ! stencil 1 + val(2, 2) = 63._RPP/128._RPP ! stencil 2 + val(2, 3) = 21._RPP/64._RPP ! stencil 3 + val(2, 4) = 9._RPP/256._RPP ! stencil 4 + case(6) ! 11th order + ! 1 => left interface (i-1/2) + val(1, 0) = 11._RPP/1024._RPP ! stencil 0 + val(1, 1) = 165._RPP/1024._RPP ! stencil 1 + val(1, 2) = 231._RPP/512._RPP ! stencil 2 + val(1, 3) = 165._RPP/512._RPP ! stencil 3 + val(1, 4) = 55._RPP/1024._RPP ! stencil 4 + val(1, 5) = 1._RPP/1024._RPP ! stencil 5 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/1024._RPP ! stencil 0 + val(2, 1) = 55._RPP/1024._RPP ! stencil 1 + val(2, 2) = 165._RPP/512._RPP ! stencil 2 + val(2, 3) = 231._RPP/512._RPP ! stencil 3 + val(2, 4) = 165._RPP/1024._RPP ! stencil 4 + val(2, 5) = 11._RPP/1024._RPP ! stencil 5 + case(7) ! 13th order + ! 1 => left interface (i-1/2) + val(1, 0) = 13._RPP/4096._RPP ! stencil 0 + val(1, 1) = 143._RPP/2048._RPP ! stencil 1 + val(1, 2) = 1287._RPP/4096._RPP ! stencil 2 + val(1, 3) = 429._RPP/1024._RPP ! stencil 3 + val(1, 4) = 179._RPP/1024._RPP ! stencil 4 + val(1, 5) = 39._RPP/2048._RPP ! stencil 5 + val(1, 6) = 1._RPP/4096._RPP ! stencil 6 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/4096._RPP ! stencil 0 + val(2, 1) = 39._RPP/2048._RPP ! stencil 1 + val(2, 2) = 179._RPP/1024._RPP ! stencil 2 + val(2, 3) = 429._RPP/1024._RPP ! stencil 3 + val(2, 4) = 1287._RPP/4096._RPP ! stencil 4 + val(2, 5) = 143._RPP/2048._RPP ! stencil 5 + val(2, 6) = 13._RPP/4096._RPP ! stencil 6 + case(8) ! 15th order + ! 1 => left interface (i-1/2) + val(1, 0) = 15._RPP/16384._RPP ! stencil 0 + val(1, 1) = 455._RPP/16384._RPP ! stencil 1 + val(1, 2) = 3003._RPP/16384._RPP ! stencil 2 + val(1, 3) = 6435._RPP/16384._RPP ! stencil 3 + val(1, 4) = 5005._RPP/16384._RPP ! stencil 4 + val(1, 5) = 1365._RPP/16384._RPP ! stencil 5 + val(1, 6) = 105._RPP/16384._RPP ! stencil 6 + val(1, 7) = 1._RPP/16384._RPP ! stencil 7 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/16384._RPP ! stencil 0 + val(2, 1) = 105._RPP/16384._RPP ! stencil 1 + val(2, 2) = 1365._RPP/16384._RPP ! stencil 2 + val(2, 3) = 5005._RPP/16384._RPP ! stencil 3 + val(2, 4) = 6435._RPP/16384._RPP ! stencil 4 + val(2, 5) = 3003._RPP/16384._RPP ! stencil 5 + val(2, 6) = 455._RPP/16384._RPP ! stencil 6 + val(2, 7) = 15._RPP/16384._RPP ! stencil 7 + case(9) ! 17th order + ! 1 => left interface (i-1/2) + val(1, 0) = 17._RPP/65536._RPP ! stencil 0 + val(1, 1) = 85._RPP/8192._RPP ! stencil 1 + val(1, 2) = 1547._RPP/16384._RPP ! stencil 2 + val(1, 3) = 2431._RPP/8192._RPP ! stencil 3 + val(1, 4) = 12155._RPP/32768._RPP ! stencil 4 + val(1, 5) = 1547._RPP/8192._RPP ! stencil 5 + val(1, 6) = 595._RPP/16384._RPP ! stencil 6 + val(1, 7) = 17._RPP/8192._RPP ! stencil 7 + val(1, 8) = 1._RPP/65536._RPP ! stencil 8 + ! 2 => right interface (i+1/2) + val(2, 0) = 1._RPP/65536._RPP ! stencil 0 + val(2, 1) = 17._RPP/8192._RPP ! stencil 1 + val(2, 2) = 595._RPP/16384._RPP ! stencil 2 + val(2, 3) = 1547._RPP/8192._RPP ! stencil 3 + val(2, 4) = 12155._RPP/32768._RPP ! stencil 4 + val(2, 5) = 2431._RPP/8192._RPP ! stencil 5 + val(2, 6) = 1547._RPP/16384._RPP ! stencil 6 + val(2, 7) = 85._RPP/8192._RPP ! stencil 7 + val(2, 8) = 17._RPP/65536._RPP ! stencil 8 + endselect + endassociate + endsubroutine compute + + pure function description(self) result(string) + !< Return string-description of kappa. + class(kappa_int_js), intent(in) :: self !< Kappa. + character(len=:), allocatable :: string !< String-description. + +#ifndef DEBUG + ! error stop in pure procedure is a F2015 feature not yet supported in debug mode + error stop 'kappa_int_js%description to be implemented, do not use!' +#endif + endfunction description + + elemental subroutine destroy(self) + !< Destroy kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + endsubroutine destroy +endmodule wenoof_kappa_int_js From 386b4a00007dacfbb42fba400c666c625157ed00 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 6 Feb 2017 15:14:42 +0100 Subject: [PATCH 03/90] Add beta coefficients for weno interpolation Short description Why: * This change addresses the need by: * Side effects: * --- .../concrete_objects/wenoof_beta_int_js.F90 | 2412 +++++++++++++++++ 1 file changed, 2412 insertions(+) create mode 100644 src/lib/concrete_objects/wenoof_beta_int_js.F90 diff --git a/src/lib/concrete_objects/wenoof_beta_int_js.F90 b/src/lib/concrete_objects/wenoof_beta_int_js.F90 new file mode 100644 index 0000000..11374e1 --- /dev/null +++ b/src/lib/concrete_objects/wenoof_beta_int_js.F90 @@ -0,0 +1,2412 @@ +!< Jiang-Shu and Gerolymos-Senechal-Vallet Beta coefficients (smoothness indicators of stencil interpolations) object. +module wenoof_beta_int_js +!< Jiang-Shu and Gerolymos-Senechal-Vallet Beta coefficients (smoothness indicators of stencil interpolations) object. +!< +!< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially +!< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, +!< doi:10.1137/070679065. + +#ifdef r16p +use penf, only: I_P, RPP=>R16P +#else +use penf, only: I_P, RPP=>R8P +#endif +use wenoof_base_object +use wenoof_beta_object + +implicit none +private +public :: beta_int_js +public :: beta_int_js_constructor + +type, extends(beta_object_constructor) :: beta_int_js_constructor + !< Jiang-Shu and Gerolymos-Senechal-Vallet beta object constructor. +endtype beta_int_js_constructor + +type, extends(beta_object) :: beta_int_js + !< Jiang-Shu and Gerolymos-Senechal-Vallet Beta coefficients (smoothness indicators of stencil interpolations) object. + !< + !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially + !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, + !< doi:10.1137/070679065. + private + real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [1:2,0:S-1,0:S-1]. + contains + ! public deferred methods + procedure, pass(self) :: create !< Create beta. + procedure, pass(self) :: compute !< Compute beta. + procedure, pass(self) :: description !< Return beta string-description. + procedure, pass(self) :: destroy !< Destroy beta. +endtype beta_int_js + +contains + ! public deferred methods + subroutine create(self, constructor) + !< Create beta. + class(beta_int_js), intent(inout) :: self !< Beta. + class(base_object_constructor), intent(in) :: constructor !< Beta constructor. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(1:2, 0:self%S - 1)) + self%values = 0._RPP + allocate(self%coef(0:self%S - 1, 0:self%S - 1, 0:self%S - 1)) + associate(c => self%coef) + select case(self%S) + case(2) ! 3rd order + ! stencil 0 + ! i*i ; (i-1)*i + c(0,0,0) = 1._RPP; c(1,0,0) = -2._RPP + ! / ; (i-1)*(i-1) + c(0,1,0) = 0._RPP; c(1,1,0) = 1._RPP + ! stencil 1 + ! (i+1)*(i+1) ; (i+1)*i + c(0,0,1) = 1._RPP; c(1,0,1) = -2._RPP + ! / ; i*i + c(0,1,1) = 0._RPP; c(1,1,1) = 1._RPP + case(3) ! 5th order + ! stencil 0 + ! i*i ; (i-1)*i ; (i-2)*i + c(0,0,0) = 10._RPP/3._RPP; c(1,0,0) = -31._RPP/3._RPP; c(2,0,0) = 11._RPP/3._RPP + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(0,1,0) = 0._RPP ; c(1,1,0) = 25._RPP/3._RPP; c(2,1,0) = -19._RPP/3._RPP + ! / ; / ; (i-2)*(i-2) + c(0,2,0) = 0._RPP ; c(1,2,0) = 0._RPP ; c(2,2,0) = 4._RPP/3._RPP + ! stencil 1 + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(0,0,1) = 4._RPP/3._RPP; c(1,0,1) = -13._RPP/3._RPP; c(2,0,1) = 5._RPP/3._RPP + ! / ; i*i ; (i-1)*i + c(0,1,1) = 0._RPP ; c(1,1,1) = 13._RPP/3._RPP; c(2,1,1) = -13._RPP/3._RPP + ! / ; / ; (i-1)*(i-1) + c(0,2,1) = 0._RPP ; c(1,2,1) = 0._RPP ; c(2,2,1) = 4._RPP/3._RPP + ! stencil 2 + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(0,0,2) = 4._RPP/3._RPP; c(1,0,2) = -19._RPP/3._RPP; c(2,0,2) = 11._RPP/3._RPP + ! / ; (i+1)*(i+1) ; i*(i+1) + c(0,1,2) = 0._RPP ; c(1,1,2) = 25._RPP/3._RPP; c(2,1,2) = -31._RPP/3._RPP + ! / ; / ; i*i + c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 10._RPP/3._RPP + case(4) ! 7th order + ! stencil 0 + ! i*i ; (i-1)*i ; (i-2)*i + c(0,0,0) = 25729._RPP / 2880._RPP; c(1,0,0) = -6383._RPP / 160._RPP; c(2,0,0) = 14369._RPP / 480._RPP + ! (i-3)*i + c(3,0,0) =-11389._RPP / 1440._RPP + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(0,1,0) = 0._RPP ; c(1,1,0) = 44747._RPP / 960._RPP; c(2,1,0) =-35047._RPP / 480._RPP + ! (i-3)*(i-1) + c(3,1,0) = 9449._RPP / 480._RPP + ! / ; / ; (i-2)*(i-2) + c(0,2,0) = 0._RPP ; c(1,2,0) = 0._RPP ; c(2,2,0) = 28547._RPP / 960._RPP + ! (i-3)*(i-2) + c(3,2,0) = -2623._RPP / 160._RPP + ! / ; / ; / + c(0,3,0) = 0._RPP ; c(1,3,0) = 0._RPP ; c(2,3,0) = 0._RPP + ! (i-3)*(i-3) + c(3,3,0) = 6649._RPP / 2880._RPP + ! stencil 1 + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(0,0,1) = 6649._RPP / 2880._RPP; c(1,0,1) = -5069._RPP / 480._RPP; c(2,0,1) = 1283._RPP / 160._RPP + ! (i-2)*(i+1) + c(3,0,1) = -2899._RPP / 1440._RPP + ! / ; i*i ; (i-1)*i + c(0,1,1) = 0._RPP ; c(1,1,1) = 13667._RPP / 960._RPP; c(2,1,1) =-11767._RPP / 480._RPP + ! (i-2)*i + c(3,1,1) = 3169._RPP / 480._RPP + ! / ; / ; (i-1)*(i-1) + c(0,2,1) = 0._RPP ; c(1,2,1) = 0._RPP ; c(2,2,1) = 11147._RPP / 960._RPP + ! (i-2)*(i-1) + c(3,2,1) = -3229._RPP / 480._RPP + ! / ; / ; / + c(0,3,1) = 0._RPP ; c(1,3,1) = 0._RPP ; c(2,3,1) = 0._RPP + ! (i-2)*(i-2) + c(3,3,1) = 3169._RPP / 2880._RPP + ! stencil 2 + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(0,0,2) = 3169._RPP / 2880._RPP; c(1,0,2) = -3229._RPP / 480._RPP; c(2,0,2) = 3169._RPP / 480._RPP + ! (i-1)*(i+2) + c(3,0,2) = -2989._RPP / 1440._RPP + ! / ; (i+1)*(i+1) ; i*(i+1) + c(0,1,2) = 0._RPP ; c(1,1,2) = 11147._RPP / 960._RPP; c(2,1,2) =-11767._RPP / 480._RPP + ! (i-1)*(i+1) + c(3,1,2) = 1283._RPP / 160._RPP + ! / ; / ; i*i + c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 13667._RPP / 960._RPP + ! (i-1)*i + c(3,2,2) = -5069._RPP / 480._RPP + ! / ; / ; / + c(0,3,2) = 0._RPP ; c(1,3,2) = 0._RPP ; c(2,3,2) = 0._RPP + ! (i-1)*(i-1) + c(3,3,2) = 6649._RPP / 2880._RPP + ! stencil 3 + ! (i+3)*(i+3) ; (i+2)*(i+3) ; (i+1)*(i+3) + c(0,0,3) = 6649._RPP / 2880._RPP; c(1,0,3) = -2623._RPP / 160._RPP; c(2,0,3) = 9449._RPP / 480._RPP + ! i*(i+3) + c(3,0,3) =-11389._RPP / 1440._RPP + ! / ; (i+2)*(i+2) ; (i+1)*(i+2) + c(0,1,3) = 0._RPP ; c(1,1,3) = 28547._RPP / 960._RPP; c(2,1,3) =-35047._RPP / 480._RPP + ! i*(i+2) + c(3,1,3) = 14369._RPP / 480._RPP + ! / ; / ; (i+1)*(i+1) + c(0,2,3) = 0._RPP ; c(1,2,3) = 0._RPP ; c(2,2,3) = 44747._RPP / 960._RPP + ! i*(i+1) + c(3,2,3) = -6383._RPP / 160._RPP + ! / ; / ; / + c(0,3,3) = 0._RPP ; c(1,3,3) = 0._RPP ; c(2,3,3) = 0._RPP + ! i*i + c(3,3,3) = 25729._RPP / 2880._RPP + case(5) ! 9th order + ! stencil 0 + ! i*i ; (i-1)*i ; (i-2)*i + c(0,0,0) = 668977._RPP / 30240._RPP; c(1,0,0) = -8055511._RPP / 60480._RPP; c(2,0,0) = 3141559._RPP / 20160._RPP + ! (i-3)*i ; (i-4)*i + c(3,0,0) = -5121853._RPP / 60480._RPP; c(4,0,0) = 1076779._RPP / 60480._RPP + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(0,1,0) = 0._RPP ; c(1,1,0) = 12627689._RPP / 60480._RPP; c(2,1,0) =-2536843._RPP / 5040._RPP + ! (i-3)*(i-1) ; (i-4)*(i-1) + c(3,1,0) = 8405471._RPP / 30240._RPP; c(4,1,0) = -3568693._RPP / 60480._RPP + ! / ; / ; (i-2)*(i-2) + c(0,2,0) = 0._RPP ; c(1,2,0) = 0._RPP ; c(2,2,0) = 2085371._RPP / 6720._RPP + ! (i-3)*(i-2) ; (i-4)*(i-2) + c(3,2,0) = -1751863._RPP / 5040._RPP; c(4,2,0) = 1501039._RPP / 20160._RPP + ! / ; / ; / + c(0,3,0) = 0._RPP ; c(1,3,0) = 0._RPP ; c(2,3,0) = 0._RPP + ! (i-3)*(i-3) ; (i-4)*(i-3) + c(3,3,0) = 5951369._RPP / 60480._RPP; c(4,3,0) = -2569471._RPP / 60480._RPP + ! / ; / ; / + c(0,4,0) = 0._RPP ; c(1,4,0) = 0._RPP ; c(2,4,0) = 0._RPP + ! / ; (i-4)*(i-4) + c(3,4,0) = 0._RPP ; c(4,4,0) = 139567._RPP / 30240._RPP + ! stencil 1 + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(0,0,1) = 139567._RPP / 30240._RPP; c(1,0,1) = -1714561._RPP / 60480._RPP; c(2,0,1) = 671329._RPP / 20160._RPP + ! (i-2)*(i+1) ; (i-3)*(i+1) + c(3,0,1) = -1079563._RPP / 60480._RPP; c(4,0,1) = 221869._RPP / 60480._RPP + ! / ; i*i ; (i-1)*i + c(0,1,1) = 0._RPP ; c(1,1,1) = 2932409._RPP / 60480._RPP; c(2,1,1) = -306569._RPP / 2520._RPP + ! (i-2)*i ; (i-3)*i + c(3,1,1) = 2027351._RPP / 30240._RPP; c(4,1,1) = -847303._RPP / 60480._RPP + ! / ; / ; (i-1)*(i-1) + c(0,2,1) = 0._RPP ; c(1,2,1) = 0._RPP ; c(2,2,1) = 539351._RPP / 6720._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(3,2,1) = -57821._RPP / 630._RPP; c(4,2,1) = 395389._RPP / 20160._RPP + ! / ; / ; / + c(0,3,1) = 0._RPP ; c(1,3,1) = 0._RPP ; c(2,3,1) = 0._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(3,3,1) = 1650569._RPP / 60480._RPP; c(4,3,1) = -725461._RPP / 60480._RPP + ! / ; / ; / + c(0,4,1) = 0._RPP ; c(1,4,1) = 0._RPP ; c(2,4,1) = 0._RPP + ! / ; (i-3)*(i-3) + c(3,4,1) = 0._RPP ; c(4,4,1) = 20591._RPP / 15120._RPP + ! stencil 2 + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(0,0,2) = 20591._RPP / 15120._RPP; c(1,0,2) = -601771._RPP / 60480._RPP; c(2,0,2) = 266659._RPP / 20160._RPP + ! (i-1)*(i+2) ; (i-2)*(i+2) + c(3,0,2) = -461113._RPP / 60480._RPP; c(4,0,2) = 98179._RPP / 60480._RPP + ! / ; (i+1)*(i+1) ; i*(i+1) + c(0,1,2) = 0._RPP ; c(1,1,2) = 1228889._RPP / 60480._RPP; c(2,1,2) = -291313._RPP / 5040._RPP + ! (i-1)*(i+1) ; (i-2)*(i+1) + c(3,1,2) = 1050431._RPP / 30240._RPP; c(4,1,2) = -461113._RPP / 60480._RPP + ! / ; / ; i*i + c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 299531._RPP / 6720._RPP + ! (i-1)*i ; (i-2)*i + c(3,2,2) = -291313._RPP / 5040._RPP; c(4,2,2) = 266659._RPP / 20160._RPP + ! / ; / ; / + c(0,3,2) = 0._RPP ; c(1,3,2) = 0._RPP ; c(2,3,2) = 0._RPP + ! (i-1)*(i-1) ; (i-2)*(i-1) + c(3,3,2) = 1228889._RPP / 60480._RPP; c(4,3,2) = -601771._RPP / 60480._RPP + ! / ; / ; / + c(0,4,2) = 0._RPP ; c(1,4,2) = 0._RPP ; c(2,4,2) = 0._RPP + ! / ; (i-2)*(i-2) + c(3,4,2) = 0._RPP ; c(4,4,2) = 20591._RPP / 15120._RPP + ! stencil 3 + ! (i+3)*(i+3) ; (i+2)*(i+3) ; (i+1)*(i+3) + c(0,0,3) = 20591._RPP / 15120._RPP; c(1,0,3) = -725461._RPP / 60480._RPP; c(2,0,3) = 395389._RPP / 20160._RPP + ! i*(i+3) ; (i-1)*(i+3) + c(3,0,3) = -847303._RPP / 60480._RPP; c(4,0,3) = 221869._RPP / 60480._RPP + ! / ; (i+2)*(i+2) ; (i+1)*(i+2) + c(0,1,3) = 0._RPP ; c(1,1,3) = 1650569._RPP / 60480._RPP; c(2,1,3) = -57821._RPP / 630._RPP + ! i*(i+2) ; (i-1)*(i+2) + c(3,1,3) = 2027351._RPP / 30240._RPP; c(4,1,3) = -1079563._RPP / 60480._RPP + ! / ; / ; (i+1)*(i+1) + c(0,2,3) = 0._RPP ; c(1,2,3) = 0._RPP ; c(2,2,3) = 539351._RPP / 6720._RPP + ! i*(i+1) ; (i-1)*(i+1) + c(3,2,3) = -3062520._RPP / 2520._RPP; c(4,2,3) = 671329._RPP / 20160._RPP + ! / ; / ; / + c(0,3,3) = 0._RPP ; c(1,3,3) = 0._RPP ; c(2,3,3) = 0._RPP + ! i*i ; (i-1)*i + c(3,3,3) = 2932409._RPP / 60480._RPP; c(4,3,3) = -1714561._RPP / 60480._RPP + ! / ; / ; / + c(0,4,3) = 0._RPP ; c(1,4,3) = 0._RPP ; c(2,4,3) = 0._RPP + ! / ; (i-1)*(i-1) + c(3,4,3) = 0._RPP ; c(4,4,3) = 139567._RPP / 30240._RPP + ! stencil 4 + ! (i+4)*(i+4) ; (i+3)*(i+4) ; (i+2)*(i+4) + c(0,0,4) = 139567._RPP / 30240._RPP; c(1,0,4) = -2569471._RPP / 60480._RPP; c(2,0,4) = 1501039._RPP / 20160._RPP + ! (i+1)*(i+4) ; i*(i+4) + c(3,0,4) = -3568693._RPP / 60480._RPP; c(4,0,4) = 1076779._RPP / 60480._RPP + ! / ; (i+3)*(i+3) ; (i+2)*(i+3) + c(0,1,4) = 0._RPP ; c(1,1,4) = 5951369._RPP / 60480._RPP; c(2,1,4) =-1751863._RPP / 5040._RPP + ! (i+1)*(i+3) ; i*(i+3) + c(3,1,4) = 8405471._RPP / 30240._RPP; c(4,1,4) = -5121853._RPP / 60480._RPP + ! / ; / ; (i+2)*(i+2) + c(0,2,4) = 0._RPP ; c(1,2,4) = 0._RPP ; c(2,2,4) = 2085371._RPP / 6720._RPP + ! (i+1)*(i+2) ; i*(i+2) + c(3,2,4) = -2536843._RPP / 5040._RPP; c(4,2,4) = 3141559._RPP / 20160._RPP + ! / ; / ; / + c(0,3,4) = 0._RPP ; c(1,3,4) = 0._RPP ; c(2,3,4) = 0._RPP + ! (i+1)*(i+1) ; i*(i+1) + c(3,3,4) = 12627689._RPP / 60480._RPP; c(4,3,4) = -8055511._RPP / 60480._RPP + ! / ; / ; / + c(0,4,4) = 0._RPP ; c(1,4,4) = 0._RPP ; c(2,4,4) = 0._RPP + ! / ; i*i + c(3,4,4) = 0._RPP ; c(4,4,4) = 668977._RPP / 30240._RPP + case(6) ! 11th order + ! stencil 0 + ! i*i ; (i-1)*i ; (i-2)*i + c(0,0,0) = 373189088._RPP / 7027375._RPP; c(1,0,0) = -157371280._RPP / 384113._RPP; c(2,0,0) = 497902688._RPP / 756325._RPP + ! (i-3)*i ; (i-4)*i ; (i-5)*i + c(3,0,0) = -427867945._RPP / 780329._RPP; c(4,0,0) = 295095211._RPP / 1259192._RPP; c(5,0,0) = -131759526._RPP / 3224383._RPP + + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(0,1,0) = 0._RPP ; c(1,1,0) = 498196769._RPP / 609968._RPP; c(2,1,0) = -497421494._RPP / 185427._RPP + ! (i-3)*(i-1) ; (i-4)*(i-1) ; (i-5)*(i-1) + c(3,1,0) = 1150428332._RPP / 508385._RPP; c(4,1,0) = -674462631._RPP / 691651._RPP; c(5,1,0) = 112453613._RPP / 657635._RPP + + ! / ; / ; (i-2)*(i-2) + c(0,2,0) = 0._RPP ; c(1,2,0) = 0._RPP ; c(2,2,0) = 2292397033._RPP / 1024803._RPP + ! (i-3)*(i-2) ; (i-4)*(i-2) ; (i-5)*(i-2) + c(3,2,0) = -378281867._RPP / 99229._RPP; c(4,2,0) = 1328498639._RPP / 803154._RPP; c(5,2,0) = -115324682._RPP / 395671._RPP + + ! / ; / ; / + c(0,3,0) = 0._RPP ; c(1,3,0) = 0._RPP ; c(2,3,0) = 0._RPP + ! (i-3)*(i-3) ; (i-4)*(i-3) ; (i-5)*(i-3) + c(3,3,0) = 1406067637._RPP / 859229._RPP; c(4,3,0) =-2146148426._RPP / 1503065._RPP; c(5,3,0) = 586668707._RPP / 2322432._RPP + + ! / ; / ; / + c(0,4,0) = 0._RPP ; c(1,4,0) = 0._RPP ; c(2,4,0) = 0._RPP + ! / ; (i-4)*(i-4) ; (i-5)*(i-4) + c(3,4,0) = 0._RPP ; c(4,4,0) = 453375035._RPP / 1449454._RPP; c(5,4,0) = -504893127._RPP / 4547012._RPP + + ! / ; / ; / + c(0,5,0) = 0._RPP ; c(1,5,0) = 0._RPP ; c(2,5,0) = 0._RPP + ! / ; / ; (i-5)*(i-5) + c(3,5,0) = 0._RPP ; c(4,5,0) = 0._RPP ; c(5,5,0) = 105552913._RPP / 10682745._RPP + ! stencil 1 + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(0,0,1) = 105552913._RPP / 10682745._RPP; c(1,0,1) = -338120165._RPP / 4351341._RPP; c(2,0,1) = 356490569._RPP / 2842289._RPP + ! (i-2)*(i+1) ; (i-3)*(i+1) ; (i-4)*(i+1) + c(3,0,1) =-146902225._RPP / 1415767._RPP; c(4,0,1) = 195395281._RPP / 4459947._RPP; c(5,0,1) = -24044484._RPP / 3193217._RPP + + ! / ; i*i ; (i-1)*i + c(0,1,1) = 0._RPP ; c(1,1,1) = 169505788._RPP / 1035915._RPP; c(2,1,1) =-2984991531._RPP / 5434265._RPP + ! (i-2)*i ; (i-3)*i ; (i-4)*i + c(3,1,1) = 771393469._RPP / 1663855._RPP; c(4,1,1) = -270758311._RPP / 1365867._RPP; c(5,1,1) = 26449004._RPP / 769961._RPP + + ! / ; / ; (i-1)*(i-1) + c(0,2,1) = 0._RPP ; c(1,2,1) = 0._RPP ; c(2,2,1) = 471933572._RPP / 993629._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) ; (i-4)*(i-1) + c(3,2,1) =-479783044._RPP / 585775._RPP; c(4,2,1) = 840802608._RPP / 2367661._RPP; c(5,2,1) = -347085621._RPP / 5587817._RPP + + ! / ; / ; / + c(0,3,1) = 0._RPP ; c(1,3,1) = 0._RPP ; c(2,3,1) = 0._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) ; (i-4)*(i-2) + c(3,3,1) =1031953342._RPP / 2867575._RPP; c(4,3,1) = -288641753._RPP / 912148._RPP; c(5,3,1) = 315600562._RPP / 5645537._RPP + + ! / ; / ; / + c(0,4,1) = 0._RPP ; c(1,4,1) = 0._RPP ; c(2,4,1) = 0._RPP + ! / ; (i-3)*(i-3) ; (i-4)*(i-3) + c(3,4,1) = 0._RPP ; c(4,4,1) = 142936745._RPP / 2029182._RPP; c(5,4,1) = -109600459._RPP / 4359925._RPP + + ! / ; / ; / + c(0,5,1) = 0._RPP ; c(1,5,1) = 0._RPP ; c(2,5,1) = 0._RPP + ! / ; / ; (i-4)*(i-4) + c(3,5,1) = 0._RPP ; c(4,5,1) = 0._RPP ; c(5,5,1) = 30913579._RPP / 13651507._RPP + ! stencil 2 + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(0,0,2) = 30913579._RPP / 13651507._RPP; c(1,0,2) = -87214523._RPP / 4439774._RPP; c(2,0,2) = 99590409._RPP / 2965471._RPP + ! (i-1)*(i+2) ; (i-2)*(i+2) ; (i-3)*(i+2) + c(3,0,2) = -95644735._RPP / 3360137._RPP; c(4,0,2) = 79135747._RPP / 6577234._RPP; c(5,0,2) = -28962993._RPP / 14228092._RPP + + ! / ; (i+1)*(i+1) ; i*(i+1) + c(0,1,2) = 0._RPP ; c(1,1,2) = 24025059._RPP / 519766._RPP; c(2,1,2) = -370146220._RPP / 2226351._RPP + ! (i-1)*(i+1) ; (i-2)*(i+1) ; (i-3)*(i+1) + c(3,1,2) = 87743770._RPP / 602579._RPP; c(4,1,2) = -1512485867._RPP / 24006092._RPP; c(5,1,2) = 251883319._RPP / 23224320._RPP + + ! / ; / ; i*i + c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 200449727._RPP / 1269707_RPP + ! (i-1)*i ; (i-2)*i ; (i-3)*i + c(3,2,2) = -274966489._RPP / 950662._RPP; c(4,2,2) = 201365679._RPP / 1563055._RPP; c(5,2,2) = -61673356._RPP / 2721737._RPP + + ! / ; / ; / + c(0,3,2) = 0._RPP ; c(1,3,2) = 0._RPP ; c(2,3,2) = 0._RPP + ! (i-1)*(i-1) ; (i-2)*(i-1) ; (i-3)*(i-1) + c(3,3,2) = 586743463._RPP / 4237706._RPP; c(4,3,2) = -723607356._RPP / 5654437._RPP; c(5,3,2) = 268747951._RPP / 11612160._RPP + + ! / ; / ; / + c(0,4,2) = 0._RPP ; c(1,4,2) = 0._RPP ; c(2,4,2) = 0._RPP + ! / ; (i-2)*(i-2) ; (i-3)*(i-2) + c(3,4,2) = 0._RPP ; c(4,4,2) = 113243845._RPP / 3672222._RPP; c(5,4,2) = -74146214._RPP / 6413969._RPP + + ! / ; / ; / + c(0,5,2) = 0._RPP ; c(1,5,2) = 0._RPP ; c(2,5,2) = 0._RPP + ! / ; / ; (i-3)*(i-3) + c(3,5,2) = 0._RPP ; c(4,5,2) = 0._RPP ; c(5,5,2) = 15418339._RPP / 13608685._RPP + ! stencil 3 + ! (i+3)*(i+3) ; (i+2)*(i+3) ; (i+1)*(i+3) + c(0,0,3) = 15418339._RPP / 13608685._RPP; c(1,0,3) = -74146214._RPP / 6413969._RPP; c(2,0,3) = 268747951._RPP / 11612160._RPP + ! i*(i+3) ; (i-1)*(i+3) ; (i-2)*(i+3) + c(3,0,3) = -61673356._RPP / 2721737._RPP; c(4,0,3) = 251883319._RPP / 23224320._RPP; c(5,0,3) = -28962993._RPP / 14228092._RPP + + ! / ; (i+2)*(i+2) ; (i+1)*(i+2) + c(0,1,3) = 0._RPP ; c(1,1,3) = 113243845._RPP / 3672222._RPP; c(2,1,3) = -723607356._RPP / 5654437._RPP + ! i*(i+2) ; (i-1)*(i+2) ; (i-2)*(i+2) + c(3,1,3) = 201365679._RPP / 1563055._RPP; c(4,1,3) = -1512485867._RPP / 24006092._RPP; c(5,1,3) = 79135747._RPP / 6577234._RPP + + ! / ; / ; (i+1)*(i+1) + c(0,2,3) = 0._RPP ; c(1,2,3) = 0._RPP ; c(2,2,3) = 586743463._RPP / 4237706._RPP + ! i*(i+1) ; (i-1)*(i+1) ; (i-2)*(i+1) + c(3,2,3) = -274966489._RPP / 950662._RPP; c(4,2,3) = 87743770._RPP / 602579._RPP; c(5,2,3) = -95644735._RPP / 3360137._RPP + + ! / ; / ; / + c(0,3,3) = 0._RPP ; c(1,3,3) = 0._RPP ; c(2,3,3) = 0._RPP + ! i*i ; (i-1)*i ; (i-2)*i + c(3,3,3) = 200449727._RPP / 1269707._RPP; c(4,3,3) = -370146220._RPP / 2226351._RPP; c(5,3,3) = 99590409._RPP / 2965471._RPP + + ! / ; / ; / + c(0,4,3) = 0._RPP ; c(1,4,3) = 0._RPP ; c(2,4,3) = 0._RPP + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(3,4,3) = 0._RPP ; c(4,4,3) = 24025059._RPP / 519766._RPP; c(5,4,3) = -87214523._RPP / 4439774._RPP + + ! / ; / ; / + c(0,5,3) = 0._RPP ; c(1,5,3) = 0._RPP ; c(2,5,3) = 0._RPP + ! / ; / ; (i-2)*(i-2) + c(3,5,3) = 0._RPP ; c(4,5,3) = 0._RPP ; c(5,5,3) = 30913579._RPP / 13651507._RPP + ! stencil 4 + ! (i+4)*(i+4) ; (i+3)*(i+4) ; (i+2)*(i+4) + c(0,0,4) = 30913579._RPP / 13651507._RPP; c(1,0,4) = -109600459._RPP / 4359925._RPP; c(2,0,4) = 315600562._RPP / 5645537._RPP + ! (i+1)*(i+4) ; i*(i+4) ; (i-1)*(i+4) + c(3,0,4) = -347085621._RPP / 5587817._RPP; c(4,0,4) = 26449004._RPP / 769961._RPP; c(5,0,4) = -24044484._RPP / 3193217._RPP + + ! / ; (i+3)*(i+3) ; (i+2)*(i+3) + c(0,1,4) = 0._RPP ; c(1,1,4) = 142936745._RPP / 2029182._RPP; c(2,1,4) = -288641753._RPP / 912148._RPP + ! (i+1)*(i+3) ; i*(i+3) ; (i-1)*(i+3) + c(3,1,4) = 840802608._RPP / 2367661._RPP; c(4,1,4) = -270758311._RPP / 1365867._RPP; c(5,1,4) = 195395281._RPP / 4459947._RPP + + ! / ; / ; (i+2)*(i+2) + c(0,2,4) = 0._RPP ; c(1,2,4) = 0._RPP ; c(2,2,4) = 1031953342._RPP / 2867575._RPP + ! (i+1)*(i+2) ; i*(i+2) ; (i-1)*(i+2) + c(3,2,4) = -479783044._RPP / 585775._RPP; c(4,2,4) = 771393469._RPP / 1663855._RPP; c(5,2,4) = -146902225._RPP / 1415767._RPP + + ! / ; / ; / + c(0,3,4) = 0._RPP ; c(1,3,4) = 0._RPP ; c(2,3,4) = 0._RPP + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(3,3,4) = 471933572._RPP / 993629._RPP; c(4,3,4) = -2984991531._RPP / 5434265._RPP; c(5,3,4) = 356490569._RPP / 2842289._RPP + + ! / ; / ; / + c(0,4,4) = 0._RPP ; c(1,4,4) = 0._RPP ; c(2,4,4) = 0._RPP + ! / ; i*i ; (i-1)*i + c(3,4,4) = 0._RPP ; c(4,4,4) = 169505788._RPP / 1035915._RPP; c(5,4,4) = -338120165._RPP / 4351341._RPP + + ! / ; / ; / + c(0,5,4) = 0._RPP ; c(1,5,4) = 0._RPP ; c(2,5,4) = 0._RPP + ! / ; / ; (i-1)*(i-1) + c(3,5,4) = 0._RPP ; c(4,5,4) = 0._RPP ; c(5,5,4) = 105552913._RPP / 10682745._RPP + ! stencil 5 + ! (i+5)*(i+5) ; (i+4)*(i+5) ; (i+3)*(i+5) + c(0,0,5) = 105552913._RPP / 10682745._RPP; c(1,0,5) = -504893127._RPP / 4547012._RPP; c(2,0,5) = 586668707._RPP / 2322432._RPP + ! (i+2)*(i+5) ; (i+1)*(i+5) ; i*(i+5) + c(3,0,5) = -115324682._RPP / 395671._RPP; c(4,0,5) = 112453613._RPP / 657635._RPP; c(5,0,5) = -131759526._RPP / 3224383._RPP + + ! / ; (i+4)*(i+3) ; (i+3)*(i+3) + c(0,1,5) = 0._RPP ; c(1,1,5) = 453375035._RPP / 1449454._RPP; c(2,1,5) = -2146148426._RPP / 1503065._RPP + ! (i+2)*(i+3) ; (i+1)*(i+3) ; i*(i+3) + c(3,1,5) = 1328498639._RPP / 803154._RPP; c(4,1,5) = -674462631._RPP / 691651._RPP; c(5,1,5) = 295095211._RPP / 1259192._RPP + + ! / ; / ; (i+3)*(i+2) + c(0,2,5) = 0._RPP ; c(1,2,5) = 0._RPP ; c(2,2,5) = 1406067637._RPP / 859229._RPP + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(3,2,5) = -378281867._RPP / 99229._RPP; c(4,2,5) = 1150428332._RPP / 508385._RPP; c(5,2,5) = -427867945._RPP / 780329._RPP + + ! / ; / ; / + c(0,3,5) = 0._RPP ; c(1,3,5) = 0._RPP ; c(2,3,5) = 0._RPP + ! (i+2)*(i+1) ; (i+1)*(i+1) ; i*(i+1) + c(3,3,5) = 2292397033._RPP / 1024803._RPP; c(4,3,5) = -497421494._RPP / 185427._RPP; c(5,3,5) = 497902668._RPP / 756325._RPP + + ! / ; / ; / + c(0,4,5) = 0._RPP ; c(1,4,5) = 0._RPP ; c(2,4,5) = 0._RPP + ! / ; (i+1)*i ; i*i + c(3,4,5) = 0._RPP ; c(4,4,5) = 498196769._RPP / 609968._RPP; c(5,4,5) = -157371280._RPP / 384113._RPP + + ! / ; / ; / + c(0,5,5) = 0._RPP ; c(1,5,5) = 0._RPP ; c(2,5,5) = 0._RPP + ! / ; / ; i*(i-1) + c(3,5,5) = 0._RPP ; c(4,5,5) = 0._RPP ; c(5,5,5) = 373189088._RPP / 7027375._RPP + case(7) ! 13th order + ! stencil 0 + ! i*i ; (i-1)*i + c(0,0,0) = 307570060._RPP/2438487._RPP; c(1,0,0) = -842151863._RPP/702281._RPP + ! (i-2)*i ; (i-3)*i + c(2,0,0) = 1025357155._RPP/415733._RPP; c(3,0,0) = -882134137._RPP/316505._RPP + ! (i-4)*i ; (i-5)*i + c(4,0,0) = 2375865880._RPP/1312047._RPP; c(5,0,0) = -418267211._RPP/655432._RPP + ! (i-6)*i + c(6,0,0) = 65647731._RPP/691205._RPP + + ! / ; (i-1)*(i-1) + c(0,1,0) = 0._RPP; c(1,1,0) = 1267010831._RPP/433225._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(2,1,0) = -2727583905._RPP/223057._RPP; c(3,1,0) = 2854637563._RPP/204507._RPP + ! (i-4)*(i-1) ; (i-5)*(i-1) + c(4,1,0) = -550697211._RPP/60310._RPP; c(5,1,0) = 803154527._RPP/248375._RPP + ! (i-6)*(i-1) + c(6,1,0) = -299800985._RPP/620702._RPP + + ! / ; / + c(0,2,0) = 0._RPP; c(1,2,0) = 0._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(2,2,0) = 2398154453._RPP/185516._RPP; c(3,2,0) = -485497721._RPP/16325._RPP + ! (i-4)*(i-2) ; (i-5)*(i-2) + c(4,2,0) = 3315206316._RPP/169489._RPP; c(5,2,0) = -1068783425._RPP/153683._RPP + ! (i-6)*(i-2) + c(6,2,0) = 412399715._RPP/395812._RPP + + ! / ; / + c(0,3,0) = 0._RPP; c(1,3,0) = 0._RPP + ! / ; (i-3)*(i-3) + c(2,3,0) = 0._RPP; c(3,3,0) = 2558389867._RPP/148729._RPP + ! (i-4)*(i-3) ; (i-5)*(i-3) + c(4,3,0) = -1833856939._RPP/80705._RPP; c(5,3,0) = 2369766527._RPP/4292389._RPP + ! (i-6)*(i-3) + c(6,3,0) = -219701291._RPP/180490._RPP + + ! / ; / + c(0,4,0) = 0._RPP; c(1,4,0) = 0._RPP + ! / ; / + c(2,4,0) = 0._RPP; c(3,4,0) = 0._RPP + ! (i-4)*(i-4) ; (i-5)*(i-4) + c(4,4,0) = 384888217._RPP/51123._RPP; c(5,4,0) = -3101495154._RPP/576017._RPP + ! (i-6)*(i-4) + c(6,4,0) = 562957181._RPP/694753._RPP + + ! / ; / + c(0,5,0) = 0._RPP; c(1,5,0) = 0._RPP + ! / ; / + c(2,5,0) = 0._RPP; c(3,5,0) = 0._RPP + ! / ; (i-5)*(i-5) + c(4,5,0) = 0._RPP; c(5,5,0) = 368117849._RPP/381597._RPP + ! (i-6)*(i-5) + c(6,5,0) = -484093752._RPP/1664533._RPP + + ! / ; / + c(0,6,0) = 0._RPP; c(1,6,0) = 0._RPP + ! / ; / + c(2,6,0) = 0._RPP; c(3,6,0) = 0._RPP + ! / ; / + c(4,6,0) = 0._RPP; c(5,6,0) = 0._RPP + ! (i-6)*(i-6) + c(6,6,0) = 118739219._RPP/5409702._RPP + ! stencil 1 + ! (i+1)*(i+1) ; i*(i+1) + c(0,0,1) = 118739219._RPP/5409702._RPP; c(1,0,1) = -258813979._RPP/1219012._RPP + ! (i-1)*(i+1) ; (i-2)*(i+1) + c(2,0,1) = 451414666._RPP/1028589._RPP; c(3,0,1) = -219042731._RPP/442919._RPP + ! (i-3)*(i+1) ; (i-4)*(i+1) + c(4,0,1) = 200564827._RPP/628331._RPP; c(5,0,1) = -1157045253._RPP/10370330._RPP + ! (i-5)*(i+1) + c(6,0,1) = 43003346._RPP/2612319._RPP + + ! / ; i*(i-1) + c(0,1,1) = 0._RPP; c(1,1,1) = 151821033._RPP/282817._RPP + ! (i-1)*(i-1) ; (i-2)*(i-1) + c(2,1,1) = -2876116249._RPP/1263255._RPP; c(3,1,1) = 6598378479._RPP/2533904._RPP + ! (i-3)*(i-1) ; (i-4)*(i-1) + c(4,1,1) = -448069659._RPP/263978._RPP; c(5,1,1) = 1029357835._RPP/1723277._RPP + ! (i-5)*(i-1) + c(6,1,1) = -265505701._RPP/2998139._RPP + + ! / ; / + c(0,2,1) = 0._RPP; c(1,2,1) = 0._RPP + ! (i-1)*(i-2) ; (i-3)*(i-2) + c(2,2,1) = 3295939303._RPP/1339169._RPP; c(3,2,1) = -952714155._RPP/166894._RPP + ! (i-4)*(i-2) ; (i-5)*(i-2) + c(4,2,1) = 656116894._RPP/174649._RPP; c(5,2,1) = -577579349._RPP/433921._RPP + ! (i-6)*(i-2) + c(6,2,1) = 265135851._RPP/1336964._RPP + + ! / ; / + c(0,3,1) = 0._RPP; c(1,3,1) = 0._RPP + ! / ; (i-2)*(i-3) + c(2,3,1) = 0._RPP; c(3,3,1) = 353679247._RPP/105637._RPP + ! (i-3)*(i-3) ; (i-4)*(i-3) + c(4,3,1) = -1397796418._RPP/314477._RPP; c(5,3,1) = 498890606._RPP/314761._RPP + ! (i-5)*(i-3) + c(6,3,1) = -246865952._RPP/1040433._RPP + + ! / ; / + c(0,4,1) = 0._RPP; c(1,4,1) = 0._RPP + ! / ; / + c(2,4,1) = 0._RPP; c(3,4,1) = 0._RPP + ! (i-3)*(i-4) ; (i-4)*(i-4) + c(4,4,1) = 1142129285._RPP/768659._RPP; c(5,4,1) = -185662673._RPP/174204._RPP + ! (i-5)*(i-4) + c(6,4,1) = 1743860591._RPP/10881504._RPP + + ! / ; / + c(0,5,1) = 0._RPP; c(1,5,1) = 0._RPP + ! / ; / + c(2,5,1) = 0._RPP; c(3,5,1) = 0._RPP + ! / ; (i-5)*(i-5) + c(4,5,1) = 0._RPP; c(5,5,1) = 393580372._RPP/2049353._RPP + ! (i-6)*(i-5) + c(6,5,1) = -483420287._RPP/8336284._RPP + + ! / ; / + c(0,6,1) = 0._RPP; c(1,6,1) = 0._RPP + ! / ; / + c(2,6,1) = 0._RPP; c(3,6,1) = 0._RPP + ! / ; / + c(4,6,1) = 0._RPP; c(5,6,1) = 0._RPP + ! (i-6)*(i-5) + c(6,6,1) = 76695443._RPP/17458022._RPP + ! stencil 2 + ! (i+2)*i ; (i+1)*i + c(0,0,2) = 76695443._RPP/17458022._RPP; c(1,0,2) = -303410983._RPP/6736159._RPP + ! i*i ; (i-1)*i + c(2,0,2) = 305770890._RPP/3186613._RPP; c(3,0,2) = -337645273._RPP/3091776._RPP + ! (i-2)*i ; (i-3)*i + c(4,0,2) = 164871587._RPP/2347023._RPP; c(5,0,2) = -205305705._RPP/8465339._RPP + ! (i-4)*i + c(6,0,2) = 77150072._RPP/21955151._RPP + + ! / ; (i+1)*(i-1) + c(0,1,2) = 0._RPP; c(1,1,2) = 266980515._RPP/2188712._RPP + ! i*(i-1) ; (i-1)*(i-1) + c(2,1,2) = -470895955._RPP/874781._RPP; c(3,1,2) = 337717185._RPP/538487._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(4,1,2) = -1002866209._RPP/2445347._RPP; c(5,1,2) = 154914521._RPP/1081252._RPP + ! (i-4)*(i-1) + c(6,1,2) = -98152843._RPP/4687720._RPP + + ! / ; / + c(0,2,2) = 0._RPP; c(1,2,2) = 0._RPP + ! i*(i-1) ; (i-1)*(i-2) + c(2,2,2) = 576629617._RPP/938378._RPP; c(3,2,2) = -631316405._RPP/429286._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(4,2,2) = 750365573._RPP/765885._RPP; c(5,2,2) = -251896262._RPP/725959._RPP + ! (i-4)*(i-2) + c(6,2,2) = 143992467._RPP/2811164._RPP + + ! / ; / + c(0,3,2) = 0._RPP; c(1,3,2) = 0._RPP + ! / ; (i-1)*(i-3) + c(2,3,2) = 0._RPP; c(3,3,2) = 449371687._RPP/498274._RPP + ! (i-2)*(i-3) ; (i-3)*(i-3) + c(4,3,2) = -660635886._RPP/538753._RPP; c(5,3,2) = 13260333719._RPP/30064515._RPP + ! (i-4)*(i-3) + c(6,3,2) = -177311125._RPP/2691566._RPP + + ! / ; / + c(0,4,2) = 0._RPP; c(1,4,2) = 0._RPP + ! / ; / + c(2,4,2) = 0._RPP; c(3,4,2) = 0._RPP + ! (i-2)*(i-4) ; (i-3)*(i-4) + c(4,4,2) = 787491691._RPP/1852394._RPP; c(5,4,2) = -393831298._RPP/1266551._RPP + ! (i-4)*(i-4) + c(6,4,2) = 85769455._RPP/1822342._RPP + + ! / ; / + c(0,5,2) = 0._RPP; c(1,5,2) = 0._RPP + ! / ; / + c(2,5,2) = 0._RPP; c(3,5,2) = 0._RPP + ! / ; (i-3)*(i-5) + c(4,5,2) = 0._RPP; c(5,5,2) = 309673793._RPP/5357421._RPP + ! (i-4)*(i-5) + c(6,5,2) = -86513123._RPP/4872070._RPP + + ! / ; / + c(0,6,2) = 0._RPP; c(1,6,2) = 0._RPP + ! / ; / + c(2,6,2) = 0._RPP; c(3,6,2) = 0._RPP + ! / ; / + c(4,6,2) = 0._RPP; c(5,6,2) = 0._RPP + ! (i-4)*(i-5) + c(6,6,2) = 20823809._RPP/15031645._RPP + ! stencil 3 + ! (i+3)*i ; (i+2)*i + c(0,0,3) = 20823809._RPP/15031645._RPP; c(1,0,3) = -85952276._RPP/5412389._RPP + ! (i+1)*i ; i*i + c(2,0,3) = 97747719._RPP/2624408._RPP; c(3,0,3) = -77947404._RPP/1703711._RPP + ! (i-1)*i ; (i-2)*i + c(4,0,3) = 78098218._RPP/2511469._RPP; c(5,0,3) = -31210580._RPP/2807109._RPP + ! (i-3)*i + c(6,0,3) = 29187600._RPP/17822477._RPP + + ! / ; (i+1)*(i-1) + c(0,1,3) = 0._RPP; c(1,1,3) = 151133283._RPP/3169976._RPP + ! i*(i-1) ; (i-1)*(i-1) + c(2,1,3) = -735436149._RPP/3170423._RPP; c(3,1,3) = 212799192._RPP/725717._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(4,1,3) = -7192946466._RPP/35277791._RPP; c(5,1,3) = 143433946._RPP/1930931._RPP + ! (i-4)*(i-1) + c(6,1,3) = -31210580._RPP/2807109._RPP + + ! / ; / + c(0,2,3) = 0._RPP; c(1,2,3) = 0._RPP + ! i*(i-1) ; (i-1)*(i-2) + c(2,2,3) = 330842346._RPP/1128355._RPP; c(3,2,3) = -478256390._RPP/624157._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(4,2,3) = 1046376941._RPP/1911720._RPP; c(5,2,3) = -7192946466._RPP/35277791._RPP + ! (i-4)*(i-2) + c(6,2,3) = 78098218._RPP/2511469._RPP + + ! / ; / + c(0,3,3) = 0._RPP; c(1,3,3) = 0._RPP + ! / ; (i-1)*(i-3) + c(2,3,3) = 0._RPP; c(3,3,3) = 1393876129._RPP/2686891._RPP + ! (i-2)*(i-3) ; (i-3)*(i-3) + c(4,3,3) = -478256390._RPP/624157._RPP; c(5,3,3) = 212799192._RPP/725717._RPP + ! (i-4)*(i-3) + c(6,3,3) = -77947404._RPP/1703711._RPP + + ! / ; / + c(0,4,3) = 0._RPP; c(1,4,3) = 0._RPP + ! / ; / + c(2,4,3) = 0._RPP; c(3,4,3) = 0._RPP + ! (i-2)*(i-4) ; (i-3)*(i-4) + c(4,4,3) = 330842346._RPP/1128355._RPP; c(5,4,3) = -735436149._RPP/3170423._RPP + ! (i-4)*(i-4) + c(6,4,3) = 97747719._RPP/2624408._RPP + + ! / ; / + c(0,5,3) = 0._RPP; c(1,5,3) = 0._RPP + ! / ; / + c(2,5,3) = 0._RPP; c(3,5,3) = 0._RPP + ! / ; (i-3)*(i-5) + c(4,5,3) = 0._RPP; c(5,5,3) = 151133283._RPP/3169976._RPP + ! (i-4)*(i-5) + c(6,5,3) = -85952276._RPP/5412389._RPP + + ! / ; / + c(0,6,3) = 0._RPP; c(1,6,3) = 0._RPP + ! / ; / + c(2,6,3) = 0._RPP; c(3,6,3) = 0._RPP + ! / ; / + c(4,6,3) = 0._RPP; c(5,6,3) = 0._RPP + ! (i-4)*(i-5) + c(6,6,3) = 20823809._RPP/15031645._RPP + ! stencil 4 + ! (i+3)*i ; (i+2)*i + c(0,0,4) = 20823809._RPP/15031645._RPP; c(1,0,4) = -86513123._RPP/4872070._RPP + ! (i+1)*i ; i*i + c(2,0,4) = 85769455._RPP/1822342._RPP; c(3,0,4) = -177311125._RPP/2691566._RPP + ! (i-1)*i ; (i-2)*i + c(4,0,4) = 143992467._RPP/2811164._RPP; c(5,0,4) = -98152843._RPP/4687720._RPP + ! (i-3)*i + c(6,0,4) = 77150072._RPP/21955151._RPP + + ! / ; (i+1)*(i-1) + c(0,1,4) = 0._RPP; c(1,1,4) = 309673793._RPP/5357421._RPP + ! i*(i-1) ; (i-1)*(i-1) + c(2,1,4) = -393831298._RPP/1266551._RPP; c(3,1,4) = 13260333719._RPP/30064515._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(4,1,4) = -251896262._RPP/725959._RPP; c(5,1,4) = 154914521._RPP/1081252._RPP + ! (i-4)*(i-1) + c(6,1,4) = -205305705._RPP/8465339._RPP + + ! / ; / + c(0,2,4) = 0._RPP; c(1,2,4) = 0._RPP + ! i*(i-1) ; (i-1)*(i-2) + c(2,2,4) = 787491691._RPP/1852394._RPP; c(3,2,4) = -660635886._RPP/538753._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(4,2,4) = 750365573._RPP/765885._RPP; c(5,2,4) = -1002866209._RPP/2445347._RPP + ! (i-4)*(i-2) + c(6,2,4) = 164871587._RPP/2347023._RPP + + ! / ; / + c(0,3,4) = 0._RPP; c(1,3,4) = 0._RPP + ! / ; (i-1)*(i-3) + c(2,3,4) = 0._RPP; c(3,3,4) = 449371687._RPP/498274._RPP + ! (i-2)*(i-3) ; (i-3)*(i-3) + c(4,3,4) = -631316405._RPP/429286._RPP; c(5,3,4) = 337717185._RPP/538487._RPP + ! (i-4)*(i-3) + c(6,3,4) = -337645273._RPP/3091776._RPP + + ! / ; / + c(0,4,4) = 0._RPP; c(1,4,4) = 0._RPP + ! / ; / + c(2,4,4) = 0._RPP; c(3,4,4) = 0._RPP + ! (i-2)*(i-4) ; (i-3)*(i-4) + c(4,4,4) = 576629617._RPP/938378._RPP; c(5,4,4) = -470895955._RPP/874781._RPP + ! (i-4)*(i-4) + c(6,4,4) = 305770890._RPP/3186613._RPP + + ! / ; / + c(0,5,4) = 0._RPP; c(1,5,4) = 0._RPP + ! / ; / + c(2,5,4) = 0._RPP; c(3,5,4) = 0._RPP + ! / ; (i-3)*(i-5) + c(4,5,4) = 0._RPP; c(5,5,4) = 266980515._RPP/2188712._RPP + ! (i-4)*(i-5) + c(6,5,4) = -303410983._RPP/6736159._RPP + + ! / ; / + c(0,6,4) = 0._RPP; c(1,6,4) = 0._RPP + ! / ; / + c(2,6,4) = 0._RPP; c(3,6,4) = 0._RPP + ! / ; / + c(4,6,4) = 0._RPP; c(5,6,4) = 0._RPP + ! (i-4)*(i-5) + c(6,6,4) = 76695443._RPP/17458022._RPP + ! stencil 5 + ! (i+3)*i ; (i+2)*i + c(0,0,5) = 76695443._RPP/17458022._RPP; c(1,0,5) = -483420287._RPP/8336284._RPP + ! (i+1)*i ; i*i + c(2,0,5) = 1743860591._RPP/10881504._RPP; c(3,0,5) = -246865952._RPP/1040433._RPP + ! (i-1)*i ; (i-2)*i + c(4,0,5) = 265135851._RPP/1336964._RPP; c(5,0,5) = -265505701._RPP/2998139._RPP + ! (i-3)*i + c(6,0,5) = 43003346._RPP/2612319._RPP + + ! / ; (i+1)*(i-1) + c(0,1,5) = 0._RPP; c(1,1,5) = 393580372._RPP/2049353._RPP + ! i*(i-1) ; (i-1)*(i-1) + c(2,1,5) = -185662673._RPP/174204._RPP; c(3,1,5) = 498890606._RPP/314761._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(4,1,5) = -577579349._RPP/433921._RPP; c(5,1,5) = 1029357835._RPP/1723277._RPP + ! (i-4)*(i-1) + c(6,1,5) = -1157045253._RPP/10370330._RPP + + ! / ; / + c(0,2,5) = 0._RPP; c(1,2,5) = 0._RPP + ! i*(i-1) ; (i-1)*(i-2) + c(2,2,5) = 1142129285._RPP/768659._RPP; c(3,2,5) = -1397796418._RPP/314477._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(4,2,5) = 656116894._RPP/174649._RPP; c(5,2,5) = -448069659._RPP/263978._RPP + ! (i-4)*(i-2) + c(6,2,5) = 200564827._RPP/628331._RPP + + ! / ; / + c(0,3,5) = 0._RPP; c(1,3,5) = 0._RPP + ! / ; (i-1)*(i-3) + c(2,3,5) = 0._RPP; c(3,3,5) = 353679247._RPP/105637._RPP + ! (i-2)*(i-3) ; (i-3)*(i-3) + c(4,3,5) = -952714155._RPP/166894._RPP; c(5,3,5) = 6598378479._RPP/2533904._RPP + ! (i-4)*(i-3) + c(6,3,5) = -219042731._RPP/442919._RPP + + ! / ; / + c(0,4,5) = 0._RPP; c(1,4,5) = 0._RPP + ! / ; / + c(2,4,5) = 0._RPP; c(3,4,5) = 0._RPP + ! (i-2)*(i-4) ; (i-3)*(i-4) + c(4,4,5) = 3295939303._RPP/1339169._RPP; c(5,4,5) = -2876116249._RPP/1263255._RPP + ! (i-4)*(i-4) + c(6,4,5) = 451414666._RPP/1028589._RPP + + ! / ; / + c(0,5,5) = 0._RPP; c(1,5,5) = 0._RPP + ! / ; / + c(2,5,5) = 0._RPP; c(3,5,5) = 0._RPP + ! / ; (i-3)*(i-5) + c(4,5,5) = 0._RPP; c(5,5,5) = 151821033._RPP/282817._RPP + ! (i-4)*(i-5) + c(6,5,5) = -258813979._RPP/1219012._RPP + + ! / ; / + c(0,6,5) = 0._RPP; c(1,6,5) = 0._RPP + ! / ; / + c(2,6,5) = 0._RPP; c(3,6,5) = 0._RPP + ! / ; / + c(4,6,5) = 0._RPP; c(5,6,5) = 0._RPP + ! (i-4)*(i-5) + c(6,6,5) = 118739219._RPP/5409702._RPP + ! stencil 6 + ! (i+3)*i ; (i+2)*i + c(0,0,6) = 118739219._RPP/5409702._RPP; c(1,0,6) = -484093752._RPP/1664533._RPP + ! (i+1)*i ; i*i + c(2,0,6) = 562957181._RPP/694753._RPP; c(3,0,6) = -219701291._RPP/180490._RPP + ! (i-1)*i ; (i-2)*i + c(4,0,6) = 412399715._RPP/395812._RPP; c(5,0,6) = -299800985._RPP/620702._RPP + ! (i-3)*i + c(6,0,6) = 65647731._RPP/691205._RPP + + ! / ; (i+1)*(i-1) + c(0,1,6) = 0._RPP; c(1,1,6) = 368117849._RPP/381597._RPP + ! i*(i-1) ; (i-1)*(i-1) + c(2,1,6) = -3101495154._RPP/576017._RPP; c(3,1,6) = 2369766527._RPP/292389._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) + c(4,1,6) = -1068783425._RPP/153683._RPP; c(5,1,6) = 803154527._RPP/248375._RPP + ! (i-4)*(i-1) + c(6,1,6) = -418267211._RPP/655432._RPP + + ! / ; / + c(0,2,6) = 0._RPP; c(1,2,6) = 0._RPP + ! i*(i-1) ; (i-1)*(i-2) + c(2,2,6) = 384888217._RPP/51123._RPP; c(3,2,6) = -1833856939._RPP/80705._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) + c(4,2,6) = 3315206316._RPP/169489._RPP; c(5,2,6) = -550697211._RPP/60310._RPP + ! (i-4)*(i-2) + c(6,2,6) = 2375865880._RPP/1312047._RPP + + ! / ; / + c(0,3,6) = 0._RPP; c(1,3,6) = 0._RPP + ! / ; (i-1)*(i-3) + c(2,3,6) = 0._RPP; c(3,3,6) = 2558389867._RPP/148729._RPP + ! (i-2)*(i-3) ; (i-3)*(i-3) + c(4,3,6) = -485497721._RPP/16325._RPP; c(5,3,6) = 2854637563._RPP/204507._RPP + ! (i-4)*(i-3) + c(6,3,6) = -882134137._RPP/316505._RPP + + ! / ; / + c(0,4,6) = 0._RPP; c(1,4,6) = 0._RPP + ! / ; / + c(2,4,6) = 0._RPP; c(3,4,6) = 0._RPP + ! (i-2)*(i-4) ; (i-3)*(i-4) + c(4,4,6) = 2398154453._RPP/185516._RPP; c(5,4,6) = -2727583905._RPP/223057._RPP + ! (i-4)*(i-4) + c(6,4,6) = 1025357155._RPP/415733._RPP + + ! / ; / + c(0,5,6) = 0._RPP; c(1,5,6) = 0._RPP + ! / ; / + c(2,5,6) = 0._RPP; c(3,5,6) = 0._RPP + ! / ; (i-3)*(i-5) + c(4,5,6) = 0._RPP; c(5,5,6) = 1267010831._RPP/433225._RPP + ! (i-4)*(i-5) + c(6,5,6) = -842151863._RPP/702281._RPP + + ! / ; / + c(0,6,6) = 0._RPP; c(1,6,6) = 0._RPP + ! / ; / + c(2,6,6) = 0._RPP; c(3,6,6) = 0._RPP + ! / ; / + c(4,6,6) = 0._RPP; c(5,6,6) = 0._RPP + ! (i-4)*(i-5) + c(6,6,6) = 307570060._RPP/2438487._RPP + case(8) ! 15th order + ! stencil 0 + ! / ; / + c(0,0,0) = 561955582._RPP/ 1878967._RPP; c(1,0,0) = -1353623375._RPP/ 398213._RPP + ! / ; / + c(2,0,0) = 1512171950._RPP/ 176773._RPP; c(3,0,0) = -1384199219._RPP/ 112909._RPP + ! / ; / + c(4,0,0) = 1191775685._RPP/ 110969._RPP; c(5,0,0) = -6701525420._RPP/ 1169941._RPP + ! / ; / + c(6,0,0) = 1730988313._RPP/ 1007913._RPP; c(7,0,0) = -167817292._RPP/ 753123._RPP + + ! / ; / + c(0,1,0) = 0._RPP; c(1,1,0) = 5230798390._RPP/ 531001._RPP + ! / ; / + c(2,1,0) = -6783346413._RPP/ 135128._RPP; c(3,1,0) = 2653665219._RPP/ 36590._RPP + ! / ; / + c(4,1,0) = -2650855638._RPP/ 41489._RPP; c(5,1,0) = 3436464517._RPP/ 100426._RPP + ! / ; / + c(6,1,0) = -8115803171._RPP/ 788565._RPP; c(7,1,0) = 1606637628._RPP/ 1200199._RPP + + ! / ; / + c(0,2,0) = 0._RPP; c(1,2,0) = 0._RPP + ! / ; / + c(2,2,0) = 3382169379._RPP/ 52433._RPP; c(3,2,0) = -4461330800._RPP/ 23793._RPP + ! / ; / + c(4,2,0) = 2354499851._RPP/ 14191._RPP; c(5,2,0) = -9679034365._RPP/ 108568._RPP + ! / ; / + c(6,2,0) = 4477231643._RPP/ 166549._RPP; c(7,2,0) = -2034860005._RPP/ 580787._RPP + + ! / ; / + c(0,3,0) = 0._RPP; c(1,3,0) = 0._RPP + ! / ; / + c(2,3,0) = 0._RPP; c(3,3,0) = 5383551615._RPP/ 39332._RPP + ! / ; / + c(4,3,0) = -10453320754._RPP/ 43009._RPP; c(5,3,0) = 7936751861._RPP/ 60613._RPP + ! / ; / + c(6,3,0) = -3946887082._RPP/ 99757._RPP; c(7,3,0) = 1168472761._RPP/ 226223._RPP + + ! / ; / + c(0,4,0) = 0._RPP; c(1,4,0) = 0._RPP + ! / ; / + c(2,4,0) = 0._RPP; c(3,4,0) = 0._RPP + ! / ; / + c(4,4,0) = 15685259234._RPP/ 144989._RPP; c(5,4,0) = -2087501693._RPP/ 17871._RPP + ! / ; / + c(6,4,0) = 12211598186._RPP/ 345407._RPP; c(7,4,0) = -1774088813._RPP/ 383858._RPP + + ! / ; / + c(0,5,0) = 0._RPP; c(1,5,0) = 0._RPP + ! / ; / + c(2,5,0) = 0._RPP; c(3,5,0) = 0._RPP + ! / ; / + c(4,5,0) = 0._RPP; c(5,5,0) = 5633451919._RPP/ 178362._RPP + ! / ; / + c(6,5,0) = -1307164757._RPP/ 68276._RPP; c(7,5,0) = 4932843539._RPP/ 1968706._RPP + + ! / ; / + c(0,6,0) = 0._RPP; c(1,6,0) = 0._RPP + ! / ; / + c(2,6,0) = 0._RPP; c(3,6,0) = 0._RPP + ! / ; / + c(4,6,0) = 0._RPP; c(5,6,0) = 0._RPP + ! / ; / + c(6,6,0) = 1285415788._RPP/ 442547._RPP; c(7,6,0) = -508083143._RPP/ 667663._RPP + + ! / ; / + c(0,7,0) = 0._RPP; c(1,7,0) = 0._RPP + ! / ; / + c(2,7,0) = 0._RPP; c(3,7,0) = 0._RPP + ! / ; / + c(4,7,0) = 0._RPP; c(5,7,0) = 0._RPP + ! / ; / + c(6,7,0) = 0._RPP; c(7,7,0) = 151567467._RPP/ 3038449._RPP + + ! stencil 1 + ! / ; / + c(0,0,1) = 151567467._RPP/ 3038449._RPP; c(1,0,1) = -464902845._RPP/ 808102._RPP + ! / ; / + c(2,0,1) = 234353207._RPP/ 161088._RPP; c(3,0,1) = -2546573797._RPP/ 1222381._RPP + ! / ; / + c(4,0,1) = 847040497._RPP/ 465789._RPP; c(5,0,1) = -12689783695._RPP/ 13147542._RPP + ! / ; / + c(6,0,1) = 362054965._RPP/ 1257877._RPP; c(7,0,1) = -115902052._RPP/ 3120403._RPP + + ! / ; / + c(0,1,1) = 0._RPP; c(1,1,1) = 960477863._RPP/ 562021._RPP + ! / ; / + c(2,1,1) = -2039339988._RPP/ 231781._RPP; c(3,1,1) = 3431063476._RPP/ 269267._RPP + ! / ; / + c(4,1,1) = -3161084857._RPP/ 282001._RPP; c(5,1,1) = 4037906091._RPP/ 674921._RPP + ! / ; / + c(6,1,1) = -850151296._RPP/ 474539._RPP; c(7,1,1) = 513945629._RPP/ 2216079._RPP + + ! / ; / + c(0,2,1) = 0._RPP; c(1,2,1) = 0._RPP + ! / ; / + c(2,2,1) = 4802121175._RPP/ 418404._RPP; c(3,2,1) = -2609137409._RPP/ 77728._RPP + ! / ; / + c(4,2,1) = 4919628784._RPP/ 165435._RPP; c(5,2,1) = -2029186932._RPP/ 127189._RPP + ! / ; / + c(6,2,1) = 2674480859._RPP/ 557634._RPP; c(7,2,1) = -724803819._RPP/ 1163906._RPP + + ! / ; / + c(0,3,1) = 0._RPP; c(1,3,1) = 0._RPP + ! / ; / + c(2,3,1) = 0._RPP; c(3,3,1) = 3485486425._RPP/ 140912._RPP + ! / ; / + c(4,3,1) = -5435379710._RPP/ 123283._RPP; c(5,3,1) = 1773946113._RPP/ 74654._RPP + ! / ; / + c(6,3,1) = -1907782262._RPP/ 266123._RPP; c(7,3,1) = 779780282._RPP/ 835427._RPP + + ! / ; / + c(0,4,1) = 0._RPP; c(1,4,1) = 0._RPP + ! / ; / + c(2,4,1) = 0._RPP; c(3,4,1) = 0._RPP + ! / ; / + c(4,4,1) = 3163565270._RPP/ 160241._RPP; c(5,4,1) = -1674462641._RPP/ 78375._RPP + ! / ; / + c(6,4,1) = 2349626332._RPP/ 363399._RPP; c(7,4,1) = -1403389204._RPP/ 1662883._RPP + + ! / ; / + c(0,5,1) = 0._RPP; c(1,5,1) = 0._RPP + ! / ; / + c(2,5,1) = 0._RPP; c(3,5,1) = 0._RPP + ! / ; / + c(4,5,1) = 0._RPP; c(5,5,1) = 3171324093._RPP/ 546871._RPP + ! / ; / + c(6,5,1) = -686664647._RPP/ 195106._RPP; c(7,5,1) = 281051417._RPP/ 610454._RPP + + ! / ; / + c(0,6,1) = 0._RPP; c(1,6,1) = 0._RPP + ! / ; / + c(2,6,1) = 0._RPP; c(3,6,1) = 0._RPP + ! / ; / + c(4,6,1) = 0._RPP; c(5,6,1) = 0._RPP + ! / ; / + c(6,6,1) = 48179335._RPP/ 90019._RPP; c(7,6,1) = -255613952._RPP/ 1821943._RPP + + ! / ; / + c(0,7,1) = 0._RPP; c(1,7,1) = 0._RPP + ! / ; / + c(2,7,1) = 0._RPP; c(3,7,1) = 0._RPP + ! / ; / + c(4,7,1) = 0._RPP; c(5,7,1) = 0._RPP + ! / ; / + c(6,7,1) = 0._RPP; c(7,7,1) = 79932001._RPP/ 8679360._RPP + + ! stencil 2 + ! / ; / + c(0,0,2) = 79932001._RPP/ 8679360._RPP; c(1,0,2) = -655235691._RPP/ 5945464._RPP + ! / ; / + c(2,0,2) = 205707004._RPP/ 724801._RPP; c(3,0,2) = -559020701._RPP/ 1367726._RPP + ! / ; / + c(4,0,2) = 610690841._RPP/ 1715763._RPP; c(5,0,2) = -179578697._RPP/ 957716._RPP + ! / ; / + c(6,0,2) = 112959697._RPP/ 2041527._RPP; c(7,0,2) = -44754099._RPP/ 6344939._RPP + + ! / ; / + c(0,1,2) = 0._RPP; c(1,1,2) = 403846727._RPP/ 1180353._RPP + ! / ; / + c(2,1,2) = -1032899132._RPP/ 571995._RPP; c(3,1,2) = 554363127._RPP/ 209623._RPP + ! / ; / + c(4,1,2) = -699001320._RPP/ 299911._RPP; c(5,1,2) = 324962019._RPP/ 262375._RPP + ! / ; / + c(6,1,2) = -649079478._RPP/ 1764673._RPP; c(7,1,2) = 129766396._RPP/ 2754429._RPP + + ! / ; / + c(0,2,2) = 0._RPP; c(1,2,2) = 0._RPP + ! / ; / + c(2,2,2) = 5814856284._RPP/ 2387539._RPP; c(3,2,2) = -1300201595._RPP/ 179203._RPP + ! / ; / + c(4,2,2) = 1056954815._RPP/ 163259._RPP; c(5,2,2) = -8089971196._RPP/ 2329825._RPP + ! / ; / + c(6,2,2) = 501175243._RPP/ 482649._RPP; c(7,2,2) = -270604594._RPP/ 2024029._RPP + + ! / ; / + c(0,3,2) = 0._RPP; c(1,3,2) = 0._RPP + ! / ; / + c(2,3,2) = 0._RPP; c(3,3,2) = 7318753887._RPP/ 1334341._RPP + ! / ; / + c(4,3,2) = -823868037._RPP/ 83150._RPP; c(5,3,2) = 4782113096._RPP/ 891381._RPP + ! / ; / + c(6,3,2) = -694807489._RPP/ 429931._RPP; c(7,3,2) = 430661427._RPP/ 2058148._RPP + + ! / ; / + c(0,4,2) = 0._RPP; c(1,4,2) = 0._RPP + ! / ; / + c(2,4,2) = 0._RPP; c(3,4,2) = 0._RPP + ! / ; / + c(4,4,2) = 1492354285._RPP/ 329872._RPP; c(5,4,2) = -799191084._RPP/ 161641._RPP + ! / ; / + c(6,4,2) = 559782185._RPP/ 373076._RPP; c(7,4,2) = -114044024._RPP/ 583601._RPP + + ! / ; / + c(0,5,2) = 0._RPP; c(1,5,2) = 0._RPP + ! / ; / + c(2,5,2) = 0._RPP; c(3,5,2) = 0._RPP + ! / ; / + c(4,5,2) = 0._RPP; c(5,5,2) = 257028097._RPP/ 188691._RPP + ! / ; / + c(6,5,2) = -493139495._RPP/ 592214._RPP; c(7,5,2) = 401318077._RPP/ 3678649._RPP + + ! / ; / + c(0,6,2) = 0._RPP; c(1,6,2) = 0._RPP + ! / ; / + c(2,6,2) = 0._RPP; c(3,6,2) = 0._RPP + ! / ; / + c(4,6,2) = 0._RPP; c(5,6,2) = 0._RPP + ! / ; / + c(6,6,2) = 629957047._RPP/ 4917482._RPP; c(7,6,2) = -141509768._RPP/ 4191221._RPP + + ! / ; / + c(0,7,2) = 0._RPP; c(1,7,2) = 0._RPP + ! / ; / + c(2,7,2) = 0._RPP; c(3,7,2) = 0._RPP + ! / ; / + c(4,7,2) = 0._RPP; c(5,7,2) = 0._RPP + ! / ; / + c(6,7,2) = 0._RPP; c(7,7,2) = 35501666._RPP/ 15868715._RPP + + ! stencil 3 + ! / ; / + c(0,0,3) = 35501666._RPP/ 15868715._RPP; c(1,0,3) = -63831289._RPP/ 2220847._RPP + ! / ; / + c(2,0,3) = 268720507._RPP/ 3437558._RPP; c(3,0,3) = -134406712._RPP/ 1150037._RPP + ! / ; / + c(4,0,3) = 148443265._RPP/ 1427854._RPP; c(5,0,3) = -103772319._RPP/ 1881526._RPP + ! / ; / + c(6,0,3) = 141070919._RPP/ 8713488._RPP; c(7,0,3) = -21873377._RPP/ 10764442._RPP + + ! / ; / + c(0,1,3) = 0._RPP; c(1,1,3) = 204776677._RPP/ 2133916._RPP + ! / ; / + c(2,1,3) = -234383777._RPP/ 435589._RPP; c(3,1,3) = 3507914221._RPP/ 4258272._RPP + ! / ; / + c(4,1,3) = -311872754._RPP/ 417681._RPP; c(5,1,3) = 422372886._RPP/ 1050263._RPP + ! / ; / + c(6,1,3) = -386869123._RPP/ 3236626._RPP; c(7,1,3) = 69576681._RPP/ 4589819._RPP + + ! / ; / + c(0,2,3) = 0._RPP; c(1,2,3) = 0._RPP + ! / ; / + c(2,2,3) = 360251831._RPP/ 463656._RPP; c(3,2,3) = -809595667._RPP/ 331812._RPP + ! / ; / + c(4,2,3) = 1441974426._RPP/ 638695._RPP; c(5,2,3) = -84200903._RPP/ 68084._RPP + ! / ; / + c(6,2,3) = 693020919._RPP/ 1859333._RPP; c(7,2,3) = -398300903._RPP/ 8329274._RPP + + ! / ; / + c(0,3,3) = 0._RPP; c(1,3,3) = 0._RPP + ! / ; / + c(2,3,3) = 0._RPP; c(3,3,3) = 755335167._RPP/ 384508._RPP + ! / ; / + c(4,3,3) = -1353219397._RPP/ 363901._RPP; c(5,3,3) = 520921076._RPP/ 250961._RPP + ! / ; / + c(6,3,3) = -543724576._RPP/ 855585._RPP; c(7,3,3) = 200885069._RPP/ 2431769._RPP + + ! / ; / + c(0,4,3) = 0._RPP; c(1,4,3) = 0._RPP + ! / ; / + c(2,4,3) = 0._RPP; c(3,4,3) = 0._RPP + ! / ; / + c(4,4,3) = 1014659207._RPP/ 563712._RPP; c(5,4,3) = -1022198433._RPP/ 498364._RPP + ! / ; / + c(6,4,3) = 379000051._RPP/ 592915._RPP; c(7,4,3) = -65777185._RPP/ 779772._RPP + + ! / ; / + c(0,5,3) = 0._RPP; c(1,5,3) = 0._RPP + ! / ; / + c(2,5,3) = 0._RPP; c(3,5,3) = 0._RPP + ! / ; / + c(4,5,3) = 0._RPP; c(5,5,3) = 789836795._RPP/ 1323609._RPP + ! / ; / + c(6,5,3) = -540913157._RPP/ 1426197._RPP; c(7,5,3) = 108380895._RPP/ 2128121._RPP + + ! / ; / + c(0,6,3) = 0._RPP; c(1,6,3) = 0._RPP + ! / ; / + c(2,6,3) = 0._RPP; c(3,6,3) = 0._RPP + ! / ; / + c(4,6,3) = 0._RPP; c(5,6,3) = 0._RPP + ! / ; / + c(6,6,3) = 358821925._RPP/ 5833643._RPP; c(7,6,3) = -39287533._RPP/ 2331609._RPP + + ! / ; / + c(0,7,3) = 0._RPP; c(1,7,3) = 0._RPP + ! / ; / + c(2,7,3) = 0._RPP; c(3,7,3) = 0._RPP + ! / ; / + c(4,7,3) = 0._RPP; c(5,7,3) = 0._RPP + ! / ; / + c(6,7,3) = 0._RPP; c(7,7,3) = 12431715._RPP/ 10534253._RPP + + ! stencil 4 + ! / ; / + c(0,0,4) = 12431715._RPP/ 10534253._RPP; c(1,0,4) = -39287533._RPP/ 2331609._RPP + ! / ; / + c(2,0,4) = 108380895._RPP/ 2128121._RPP; c(3,0,4) = -65777185._RPP/ 779772._RPP + ! / ; / + c(4,0,4) = 200885069._RPP/ 2431769._RPP; c(5,0,4) = -398300903._RPP/ 8329274._RPP + ! / ; / + c(6,0,4) = 69576681._RPP/ 4589819._RPP; c(7,0,4) = -21873377._RPP/ 10764442._RPP + + ! / ; / + c(0,1,4) = 0._RPP; c(1,1,4) = 358821925._RPP/ 5833643._RPP + ! / ; / + c(2,1,4) = -540913157._RPP/ 1426197._RPP; c(3,1,4) = 379000051._RPP/ 592915._RPP + ! / ; / + c(4,1,4) = -543724576._RPP/ 855585._RPP; c(5,1,4) = 693020919._RPP/ 1859333._RPP + ! / ; / + c(6,1,4) = -386869123._RPP/ 3236626._RPP; c(7,1,4) = 141070919._RPP/ 8713488._RPP + + ! / ; / + c(0,2,4) = 0._RPP; c(1,2,4) = 0._RPP + ! / ; / + c(2,2,4) = 789836795._RPP/ 1323609._RPP; c(3,2,4) = -1022198433._RPP/ 498364._RPP + ! / ; / + c(4,2,4) = 520921076._RPP/ 250961._RPP; c(5,2,4) = -84200903._RPP/ 68084._RPP + ! / ; / + c(6,2,4) = 422372886._RPP/ 1050263._RPP; c(7,2,4) = -103772319._RPP/ 1881526._RPP + + ! / ; / + c(0,3,4) = 0._RPP; c(1,3,4) = 0._RPP + ! / ; / + c(2,3,4) = 0._RPP; c(3,3,4) = 1014659207._RPP/ 563712._RPP + ! / ; / + c(4,3,4) = -1353219397._RPP/ 363901._RPP; c(5,3,4) = 1441974426._RPP/ 638695._RPP + ! / ; / + c(6,3,4) = -311872754._RPP/ 417681._RPP; c(7,3,4) = 148443265._RPP/ 1427854._RPP + + ! / ; / + c(0,4,4) = 0._RPP; c(1,4,4) = 0._RPP + ! / ; / + c(2,4,4) = 0._RPP; c(3,4,4) = 0._RPP + ! / ; / + c(4,4,4) = 755335167._RPP/ 384508._RPP; c(5,4,4) = -809595667._RPP/ 331812._RPP + ! / ; / + c(6,4,4) = 3507914221._RPP/ 4258272._RPP; c(7,4,4) = -134406712._RPP/ 1150037._RPP + + ! / ; / + c(0,5,4) = 0._RPP; c(1,5,4) = 0._RPP + ! / ; / + c(2,5,4) = 0._RPP; c(3,5,4) = 0._RPP + ! / ; / + c(4,5,4) = 0._RPP; c(5,5,4) = 360251831._RPP/ 463656._RPP + ! / ; / + c(6,5,4) = -234383777._RPP/ 435589._RPP; c(7,5,4) = 268720507._RPP/ 3437558._RPP + + ! / ; / + c(0,6,4) = 0._RPP; c(1,6,4) = 0._RPP + ! / ; / + c(2,6,4) = 0._RPP; c(3,6,4) = 0._RPP + ! / ; / + c(4,6,4) = 0._RPP; c(5,6,4) = 0._RPP + ! / ; / + c(6,6,4) = 204776677._RPP/ 2133916._RPP; c(7,6,4) = -63831289._RPP/ 2220847._RPP + + ! / ; / + c(0,7,4) = 0._RPP; c(1,7,4) = 0._RPP + ! / ; / + c(2,7,4) = 0._RPP; c(3,7,4) = 0._RPP + ! / ; / + c(4,7,4) = 0._RPP; c(5,7,4) = 0._RPP + ! / ; / + c(6,7,4) = 0._RPP; c(7,7,4) = 35501666._RPP/ 15868715._RPP + ! stencil 5 + ! / ; / + c(0,0,5) = 35501666._RPP/ 15868715._RPP; c(1,0,5) = -141509768._RPP/ 4191221._RPP + ! / ; / + c(2,0,5) = 401318077._RPP/ 3678649._RPP; c(3,0,5) = -114044024._RPP/ 583601._RPP + ! / ; / + c(4,0,5) = 430661427._RPP/ 2058148._RPP; c(5,0,5) = -270604594._RPP/ 2024029._RPP + ! (i-4)*(i-5) ; + c(6,0,5) = 129766396._RPP/ 2754429._RPP; c(7,0,5) = -44754099._RPP/ 6344939._RPP + + ! / ; / + c(0,1,5) = 0._RPP; c(1,1,5) = 629957047._RPP/ 4917482._RPP + ! / ; / + c(2,1,5) = -493139495._RPP/ 592214._RPP; c(3,1,5) = 559782185._RPP/ 373076._RPP + ! / ; / + c(4,1,5) = -694807489._RPP/ 429931._RPP; c(5,1,5) = 501175243._RPP/ 482649._RPP + ! (i-4)*(i-5) ; + c(6,1,5) = -649079478._RPP/ 1764673._RPP; c(7,1,5) = 112959697._RPP/ 2041527._RPP + + ! / ; / + c(0,2,5) = 0._RPP; c(1,2,5) = 0._RPP + ! / ; / + c(2,2,5) = 257028097._RPP/ 188691._RPP; c(3,2,5) = -799191084._RPP/ 161641._RPP + ! / ; / + c(4,2,5) = 4782113096._RPP/ 891381._RPP; c(5,2,5) = -8089971196._RPP/ 2329825._RPP + ! (i-4)*(i-5) ; + c(6,2,5) = 324962019._RPP/ 262375._RPP; c(7,2,5) = -179578697._RPP/ 957716._RPP + + ! / ; / + c(0,3,5) = 0._RPP; c(1,3,5) = 0._RPP + ! / ; / + c(2,3,5) = 0._RPP; c(3,3,5) = 1492354285._RPP/ 329872._RPP + ! / ; / + c(4,3,5) = -823868037._RPP/ 83150._RPP; c(5,3,5) = 1056954815._RPP/ 163259._RPP + ! (i-4)*(i-5) ; + c(6,3,5) = -699001320._RPP/ 299911._RPP; c(7,3,5) = 610690841._RPP/ 1715763._RPP + + ! / ; / + c(0,4,5) = 0._RPP; c(1,4,5) = 0._RPP + ! / ; / + c(2,4,5) = 0._RPP; c(3,4,5) = 0._RPP + ! / ; / + c(4,4,5) = 7318753887._RPP/ 1334341._RPP; c(5,4,5) = -1300201595._RPP/ 179203._RPP + ! (i-4)*(i-5) ; + c(6,4,5) = 554363127._RPP/ 209623._RPP; c(7,4,5) = -559020701._RPP/ 1367726._RPP + + ! / ; / + c(0,5,5) = 0._RPP; c(1,5,5) = 0._RPP + ! / ; / + c(2,5,5) = 0._RPP; c(3,5,5) = 0._RPP + ! / ; / + c(4,5,5) = 0._RPP; c(5,5,5) = 5814856284._RPP/ 2387539._RPP + ! (i-4)*(i-5) ; + c(6,5,5) = -1032899132._RPP/ 571995._RPP; c(7,5,5) = 205707004._RPP/ 724801._RPP + + ! / ; / + c(0,6,5) = 0._RPP; c(1,6,5) = 0._RPP + ! / ; / + c(2,6,5) = 0._RPP; c(3,6,5) = 0._RPP + ! / ; / + c(4,6,5) = 0._RPP; c(5,6,5) = 0._RPP + ! (i-4)*(i-5) ; + c(6,6,5) = 403846727._RPP/ 1180353._RPP; c(7,6,5) = -655235691._RPP/ 5945464._RPP + + ! / ; / + c(0,7,5) = 0._RPP; c(1,7,5) = 0._RPP + ! / ; / + c(2,7,5) = 0._RPP; c(3,7,5) = 0._RPP + ! / ; / + c(4,7,5) = 0._RPP; c(5,7,5) = 0._RPP + ! (i-4)*(i-5) ; + c(6,7,5) = 0._RPP; c(7,7,5) = 79932001._RPP/ 8679360._RPP + + ! stencil 6 + ! / ; / + c(0,0,6) = 79932001._RPP/ 8679360._RPP; c(1,0,6) = -255613952._RPP/ 1821943._RPP + ! / ; / + c(2,0,6) = 281051417._RPP/ 610454._RPP; c(3,0,6) = -1403389204._RPP/ 1662883._RPP + ! / ; / + c(4,0,6) = 779780282._RPP/ 835427._RPP; c(5,0,6) = -724803819._RPP/ 1163906._RPP + ! (i-4)*(i-5) ; + c(6,0,6) = 513945629._RPP/ 2216079._RPP; c(7,0,6) = -115902052._RPP/ 3120403._RPP + + ! / ; / + c(0,1,6) = 0._RPP; c(1,1,6) = 48179335._RPP/ 90019._RPP + ! / ; / + c(2,1,6) = -686664647._RPP/ 195106._RPP; c(3,1,6) = 2349626332._RPP/ 363399._RPP + ! / ; / + c(4,1,6) = -1907782262._RPP/ 266123._RPP; c(5,1,6) = 2674480859._RPP/ 557634._RPP + ! (i-4)*(i-5) ; + c(6,1,6) = -850151296._RPP/ 474539._RPP; c(7,1,6) = 362054965._RPP/ 1257877._RPP + + ! / ; / + c(0,2,6) = 0._RPP; c(1,2,6) = 0._RPP + ! / ; / + c(2,2,6) = 3171324093._RPP/ 546871._RPP; c(3,2,6) = -1674462641._RPP/ 78375._RPP + ! / ; / + c(4,2,6) = 1773946113._RPP/ 74654._RPP; c(5,2,6) = -2029186932._RPP/ 127189._RPP + ! (i-4)*(i-5) ; + c(6,2,6) = 4037906091._RPP/ 674921._RPP; c(7,2,6) = -12689783695._RPP/ 13147542._RPP + + ! / ; / + c(0,3,6) = 0._RPP; c(1,3,6) = 0._RPP + ! / ; / + c(2,3,6) = 0._RPP; c(3,3,6) = 3163565270._RPP/ 160241._RPP + ! / ; / + c(4,3,6) = -5435379710._RPP/ 123283._RPP; c(5,3,6) = 4919628784._RPP/ 165435._RPP + ! (i-4)*(i-5) ; + c(6,3,6) = -3161084857._RPP/ 282001._RPP; c(7,3,6) = 847040497._RPP/ 465789._RPP + + ! / ; / + c(0,4,6) = 0._RPP; c(1,4,6) = 0._RPP + ! / ; / + c(2,4,6) = 0._RPP; c(3,4,6) = 0._RPP + ! / ; / + c(4,4,6) = 3485486425._RPP/ 140912._RPP; c(5,4,6) = -2609137409._RPP/ 77728._RPP + ! (i-4)*(i-5) ; + c(6,4,6) = 3431063476._RPP/ 269267._RPP; c(7,4,6) = -2546573797._RPP/ 1222381._RPP + + ! / ; / + c(0,5,6) = 0._RPP; c(1,5,6) = 0._RPP + ! / ; / + c(2,5,6) = 0._RPP; c(3,5,6) = 0._RPP + ! / ; / + c(4,5,6) = 0._RPP; c(5,5,6) = 4802121175._RPP/ 418404._RPP + ! (i-4)*(i-5) ; + c(6,5,6) = -2039339988._RPP/ 231781._RPP; c(7,5,6) = 234353207._RPP/ 161088._RPP + + ! / ; / + c(0,6,6) = 0._RPP; c(1,6,6) = 0._RPP + ! / ; / + c(2,6,6) = 0._RPP; c(3,6,6) = 0._RPP + ! / ; / + c(4,6,6) = 0._RPP; c(5,6,6) = 0._RPP + ! (i-4)*(i-5) ; + c(6,6,6) = 960477863._RPP/ 562021._RPP; c(7,6,6) = -464902845._RPP/ 808102._RPP + + ! / ; / + c(0,7,6) = 0._RPP; c(1,7,6) = 0._RPP + ! / ; / + c(2,7,6) = 0._RPP; c(3,7,6) = 0._RPP + ! / ; / + c(4,7,6) = 0._RPP; c(5,7,6) = 0._RPP + ! (i-4)*(i-5) ; + c(6,7,6) = 0._RPP; c(7,7,6) = 151567467._RPP/ 3038449._RPP + + ! stencil 7 + ! / ; / + c(0,0,7) = 151567467._RPP/ 3038449._RPP; c(1,0,7) = -508083143._RPP/ 667663._RPP + ! / ; / + c(2,0,7) = 4932843539._RPP/ 1968706._RPP; c(3,0,7) = -1774088813._RPP/ 383858._RPP + ! / ; / + c(4,0,7) = 1168472761._RPP/ 226223._RPP; c(5,0,7) = -2034860005._RPP/ 580787._RPP + ! (i-4)*(i-5) ; + c(6,0,7) = 1606637628._RPP/ 1200199._RPP; c(7,0,7) = -167817292._RPP/ 753123._RPP + + ! / ; / + c(0,1,7) = 0._RPP; c(1,1,7) = 1285415788._RPP/ 442547._RPP + ! / ; / + c(2,1,7) = -1307164757._RPP/ 68276._RPP; c(3,1,7) = 12211598186._RPP/ 345407._RPP + ! / ; / + c(4,1,7) = -3946887082._RPP/ 99757._RPP; c(5,1,7) = 4477231643._RPP/ 166549._RPP + ! (i-4)*(i-5) ; + c(6,1,7) = -8115803171._RPP/ 788565._RPP; c(7,1,7) = 1730988313._RPP/ 1007913._RPP + + ! / ; / + c(0,2,7) = 0._RPP; c(1,2,7) = 0._RPP + ! / ; / + c(2,2,7) = 5633451919._RPP/ 178362._RPP; c(3,2,7) = -2087501693._RPP/ 17871._RPP + ! / ; / + c(4,2,7) = 7936751861._RPP/ 60613._RPP; c(5,2,7) = -9679034365._RPP/ 108568._RPP + ! (i-4)*(i-5) ; + c(6,2,7) = 3436464517._RPP/ 100426._RPP; c(7,2,7) = -6701525420._RPP/ 1169941._RPP + + ! / ; / + c(0,3,7) = 0._RPP; c(1,3,7) = 0._RPP + ! / ; / + c(2,3,7) = 0._RPP; c(3,3,7) = 15685259234._RPP/ 144989._RPP + ! / ; / + c(4,3,7) = -10453320754._RPP/ 43009._RPP; c(5,3,7) = 2354499851._RPP/ 14191._RPP + ! (i-4)*(i-5) ; + c(6,3,7) = -2650855638._RPP/ 41489._RPP; c(7,3,7) = 1191775685._RPP/ 110969._RPP + + ! / ; / + c(0,4,7) = 0._RPP; c(1,4,7) = 0._RPP + ! / ; / + c(2,4,7) = 0._RPP; c(3,4,7) = 0._RPP + ! / ; / + c(4,4,7) = 5383551615._RPP/ 39332._RPP; c(5,4,7) = -4461330800._RPP/ 23793._RPP + ! (i-4)*(i-5) ; + c(6,4,7) = 2653665219._RPP/ 36590._RPP; c(7,4,7) = -1384199219._RPP/ 112909._RPP + + ! / ; / + c(0,5,7) = 0._RPP; c(1,5,7) = 0._RPP + ! / ; / + c(2,5,7) = 0._RPP; c(3,5,7) = 0._RPP + ! / ; / + c(4,5,7) = 0._RPP; c(5,5,7) = 3382169379._RPP/ 52433._RPP + ! (i-4)*(i-5) ; + c(6,5,7) = -6783346413._RPP/ 135128._RPP; c(7,5,7) = 1512171950._RPP/ 176773._RPP + + ! / ; / + c(0,6,7) = 0._RPP; c(1,6,7) = 0._RPP + ! / ; / + c(2,6,7) = 0._RPP; c(3,6,7) = 0._RPP + ! / ; / + c(4,6,7) = 0._RPP; c(5,6,7) = 0._RPP + ! (i-4)*(i-5) ; + c(6,6,7) = 5230798390._RPP/ 531001._RPP; c(7,6,7) = -1353623375._RPP/ 398213._RPP + + ! / ; / + c(0,7,7) = 0._RPP; c(1,7,7) = 0._RPP + ! / ; / + c(2,7,7) = 0._RPP; c(3,7,7) = 0._RPP + ! / ; / + c(4,7,7) = 0._RPP; c(5,7,7) = 0._RPP + ! (i-4)*(i-5) ; + c(6,7,7) = 0._RPP; c(7,7,7) = 561955582._RPP/ 1878967._RPP + case(9) ! 17th order + ! stencil 0 + ! / ; / + c(0,0,0) = 191906863._RPP/ 270061._RPP;c(1,0,0) = -1291706883._RPP/ 137012._RPP + ! / ; / + c(2,0,0) = 1051885279._RPP/37394._RPP;c(3,0,0) = -6519672839._RPP/ 133134._RPP + ! / ; / + c(4,0,0) = 8028408627._RPP/ 148285._RPP;c(5,0,0) = -12858081715._RPP/331389._RPP + ! / ; / + c(6,0,0) = 7116193241._RPP/405236._RPP;c(7,0,0) = -1382011106._RPP/301683._RPP + ! / ; / + c(8,0,0) = 380112881._RPP/ 721737._RPP + + ! / ; / + c(0,1,0) = 0._RPP;c(1,1,0) = 2789709824._RPP/ 87891._RPP + ! / ; / + c(2,1,0) = -2523726139._RPP/ 13197._RPP;c(3,1,0) = 10624327325._RPP/ 31707._RPP + ! / ; / + c(4,1,0) = -14121568547._RPP/ 37942._RPP;c(5,1,0) = 13666821827._RPP/ 51060._RPP + ! / ; / + c(6,1,0) = -7097325924._RPP/ 58429._RPP;c(7,1,0) = 962141663._RPP/ 30298._RPP + ! / ; / + c(8,1,0) = -1039356853._RPP/284187._RPP + + ! / ; / + c(0,2,0) = 0._RPP;c(1,2,0) = 0._RPP + ! / ; / + c(2,2,0) = 958711850795._RPP/ 3306139._RPP;c(3,2,0) = -32612776236._RPP/ 31939._RPP + ! / ; / + c(4,2,0) = 29334155111._RPP/ 25771._RPP;c(5,2,0) = -13491549889._RPP/ 16436._RPP + ! / ; / + c(6,2,0) = 8640690184._RPP/ 23145._RPP;c(7,2,0) = -7469836609._RPP/ 76401._RPP + ! / ; / + c(8,2,0) = 2160095091._RPP/191558._RPP + + ! / ; / + c(0,3,0) = 0._RPP;c(1,3,0) = 0._RPP + ! / ; / + c(2,3,0) = 0._RPP;c(3,3,0) = 26479157148._RPP/ 29351._RPP + ! / ; / + c(4,3,0) = -34046474687._RPP/ 16880._RPP;c(5,3,0) = 25425670807._RPP/ 17442._RPP + ! / ; / + c(6,3,0) = -13534679320._RPP/ 20379._RPP;c(7,3,0) = 8534140303._RPP/ 48995._RPP + ! / ; / + c(8,3,0) = -16400242834._RPP/815393._RPP + + ! / ; / + c(0,4,0) = 0._RPP;c(1,4,0) = 0._RPP + ! / ; / + c(2,4,0) = 0._RPP;c(3,4,0) = 0._RPP + ! / ; / + c(4,4,0) = 7211727349._RPP/ 6383._RPP;c(5,4,0) = -32852743324._RPP/ 20081._RPP + ! / ; / + c(6,4,0) = 9817971019._RPP/ 13153._RPP;c(7,4,0) = -29831101642._RPP/ 152201._RPP + ! / ; / + c(8,4,0) = 1211629703._RPP/ 53483._RPP + + ! / ; / + c(0,5,0) = 0._RPP;c(1,5,0) = 0._RPP + ! / ; / + c(2,5,0) = 0._RPP;c(3,5,0) = 0._RPP + ! / ; / + c(4,5,0) = 0._RPP;c(5,5,0) = 181942554161._RPP/ 306771._RPP + ! / ; / + c(6,5,0) = -10120501295._RPP/ 18678._RPP;c(7,5,0) = 6203677189._RPP/ 43561._RPP + ! / ; / + c(8,5,0) = -800361473._RPP/ 48582._RPP + + ! / ; / + c(0,6,0) = 0._RPP;c(1,6,0) = 0._RPP + ! / ; / + c(2,6,0) = 0._RPP;c(3,6,0) = 0._RPP + ! / ; / + c(4,6,0) = 0._RPP;c(5,6,0) = 0._RPP + ! / ; / + c(6,6,0) = 9873545067._RPP/ 79705._RPP;c(7,6,0) = -5910597075._RPP/ 90694._RPP + ! / ; / + c(8,6,0) = 2005851423._RPP/265880._RPP + + ! / ; / + c(0,7,0) = 0._RPP;c(1,7,0) = 0._RPP + ! / ; / + c(2,7,0) = 0._RPP;c(3,7,0) = 0._RPP + ! / ; / + c(4,7,0) = 0._RPP;c(5,7,0) = 0._RPP + ! / ; / + c(6,7,0) = 0._RPP;c(7,7,0) = 1207396129._RPP/140764._RPP + ! / ; / + c(8,7,0) = -989259649._RPP/ 497859._RPP + + ! / ; / + c(0,8,0) = 0._RPP;c(1,8,0) = 0._RPP + ! / ; / + c(2,8,0) = 0._RPP;c(3,8,0) = 0._RPP + ! / ; / + c(4,8,0) = 0._RPP;c(5,8,0) = 0._RPP + ! / ; / + c(6,8,0) = 0._RPP;c(7,8,0) = 0._RPP + ! / ; / + c(8,8,0) = 23000337._RPP/ 199768._RPP + + ! stencil 1 + ! / ; / + c(0,0,1) = 23000337._RPP/ 199768._RPP;c(1,0,1) = -1605498941._RPP/ 1038640._RPP + ! / ; / + c(2,0,1) = 1919279425._RPP/ 414313._RPP;c(3,0,1) = -351689199._RPP/43600._RPP + ! / ; / + c(4,0,1) = 2318146475._RPP/ 260443._RPP;c(5,0,1) = -1432715713._RPP/225284._RPP + ! / ; / + c(6,0,1) = 1206026846._RPP/420471._RPP;c(7,0,1) = -433682386._RPP/ 581703._RPP + ! / ; / + c(8,0,1) = 192493416._RPP/2253847._RPP + + ! / ; / + c(0,1,1) = 0._RPP;c(1,1,1) = 8788336457._RPP/1659246._RPP + ! / ; / + c(2,1,1) = -6349489117._RPP/ 197436._RPP;c(3,1,1) = 17759778441._RPP/ 314408._RPP + ! / ; / + c(4,1,1) = -2463944763._RPP/ 39286._RPP;c(5,1,1) = 2631734550._RPP/ 58459._RPP + ! / ; / + c(6,1,1) = -684405583._RPP/ 33590._RPP;c(7,1,1) = 1632642660._RPP/ 307433._RPP + ! / ; / + c(8,1,1) = -759205271._RPP/1245236._RPP + + ! / ; / + c(0,2,1) = 0._RPP;c(1,2,1) = 0._RPP + ! / ; / + c(2,2,1) = 138686396638._RPP/ 2813507._RPP;c(3,2,1) = -12258216466._RPP/ 70285._RPP + ! / ; / + c(4,2,1) = 8450768743._RPP/ 43407._RPP;c(5,2,1) = -30871077827._RPP/ 220014._RPP + ! / ; / + c(6,2,1) = 2904329890._RPP/ 45589._RPP;c(7,2,1) = -2519869819._RPP/ 151381._RPP + ! / ; / + c(8,2,1) = 2064497172._RPP/1078127._RPP + + ! / ; / + c(0,3,1) = 0._RPP;c(1,3,1) = 0._RPP + ! / ; / + c(2,3,1) = 0._RPP;c(3,3,1) = 7222761881._RPP/ 46553._RPP + ! / ; / + c(4,3,1) = -21436202114._RPP/ 61611._RPP;c(5,3,1) = 21903079582._RPP/ 87043._RPP + ! / ; / + c(6,3,1) = -5737609802._RPP/ 50081._RPP;c(7,3,1) = 2675355119._RPP/ 89174._RPP + ! / ; / + c(8,3,1) = -1275601375._RPP/368936._RPP + + ! / ; / + c(0,4,1) = 0._RPP;c(1,4,1) = 0._RPP + ! / ; / + c(2,4,1) = 0._RPP;c(3,4,1) = 0._RPP + ! / ; / + c(4,4,1) = 5232843359._RPP/ 26730._RPP;c(5,4,1) = -32956224478._RPP/ 116041._RPP + ! / ; / + c(6,4,1) = 4693138545._RPP/ 36209._RPP;c(7,4,1) = -5136703769._RPP/ 151046._RPP + ! / ; / + c(8,4,1) = 1990119523._RPP/ 506979._RPP + + ! / ; / + c(0,5,1) = 0._RPP;c(1,5,1) = 0._RPP + ! / ; / + c(2,5,1) = 0._RPP;c(3,5,1) = 0._RPP + ! / ; / + c(4,5,1) = 0._RPP;c(5,5,1) = 10194856899._RPP/ 98734._RPP + ! / ; / + c(6,5,1) = -7652084383._RPP/ 81028._RPP;c(7,5,1) = 1696424402._RPP/ 68349._RPP + ! / ; / + c(8,5,1) = -557744521._RPP/194407._RPP + + ! / ; / + c(0,6,1) = 0._RPP;c(1,6,1) = 0._RPP + ! / ; / + c(2,6,1) = 0._RPP;c(3,6,1) = 0._RPP + ! / ; / + c(4,6,1) = 0._RPP;c(5,6,1) = 0._RPP + ! / ; / + c(6,6,1) = 3171898228._RPP/ 146643._RPP;c(7,6,1) = -1486183058._RPP/ 130527._RPP + ! / ; / + c(8,6,1) = 1414733955._RPP/1073627._RPP + + ! / ; / + c(0,7,1) = 0._RPP;c(1,7,1) = 0._RPP + ! / ; / + c(2,7,1) = 0._RPP;c(3,7,1) = 0._RPP + ! / ; / + c(4,7,1) = 0._RPP;c(5,7,1) = 0._RPP + ! / ; / + c(6,7,1) = 0._RPP;c(7,7,1) = 550334507._RPP/ 366830._RPP + ! / ; / + c(8,7,1) = -296572045._RPP/ 853161._RPP + + ! / ; / + c(0,8,1) = 0._RPP;c(1,8,1) = 0._RPP + ! / ; / + c(2,8,1) = 0._RPP;c(3,8,1) = 0._RPP + ! / ; / + c(4,8,1) = 0._RPP;c(5,8,1) = 0._RPP + ! / ; / + c(6,8,1) = 0._RPP;c(7,8,1) = 0._RPP + ! / ; / + c(8,8,1) = 36409563._RPP/ 1806520._RPP + + ! stencil 2 + ! / ; / + c(0,0,2) = 36409563._RPP/ 1806520._RPP;c(1,0,2) = -699447262._RPP/ 2521667._RPP + ! / ; / + c(2,0,2) = 277579576._RPP/329887._RPP;c(3,0,2) = -289784372._RPP/196989._RPP + ! / ; / + c(4,0,2) = 306856831._RPP/ 189251._RPP;c(5,0,2) = -61463934._RPP/53285._RPP + ! / ; / + c(6,0,2) = 688214053._RPP/1331147._RPP;c(7,0,2) = -173397370._RPP/1299717._RPP + ! / ; / + c(8,0,2) = 265338548._RPP/17495633._RPP + + ! / ; / + c(0,1,2) = 0._RPP;c(1,1,2) = 526012837._RPP/537300._RPP + ! / ; / + c(2,1,2) = -1651888798._RPP/ 273307._RPP;c(3,1,2) = 2363787227._RPP/ 220958._RPP + ! / ; / + c(4,1,2) = -10107954583._RPP/ 849559._RPP;c(5,1,2) = 5241495620._RPP/ 615127._RPP + ! / ; / + c(6,1,2) = -2367490577._RPP/ 616772._RPP;c(7,1,2) = 127754174._RPP/ 128481._RPP + ! / ; / + c(8,1,2) = -264553111._RPP/ 2333462._RPP + + ! / ; / + c(0,2,2) = 0._RPP;c(1,2,2) = 0._RPP + ! / ; / + c(2,2,2) = 3248190394._RPP/ 343067._RPP;c(3,2,2) = -2028942806._RPP/ 59843._RPP + ! / ; / + c(4,2,2) = 1334723167._RPP/ 35090._RPP;c(5,2,2) = -765629878._RPP/ 27919._RPP + ! / ; / + c(6,2,2) = 2097415117._RPP/ 168915._RPP;c(7,2,2) = -676787627._RPP/ 209575._RPP + ! / ; / + c(8,2,2) = 383212815._RPP/1037536._RPP + + ! / ; / + c(0,3,2) = 0._RPP;c(1,3,2) = 0._RPP + ! / ; / + c(2,3,2) = 0._RPP;c(3,3,2) = 2631362108._RPP/ 85845._RPP + ! / ; / + c(4,3,2) = -4882065990._RPP/ 70417._RPP;c(5,3,2) = 3655479387._RPP/ 72668._RPP + ! / ; / + c(6,3,2) = -2468363819._RPP/ 107827._RPP;c(7,3,2) = 1268411423._RPP/ 212206._RPP + ! / ; / + c(8,3,2) = -427576737._RPP/623480._RPP + + ! / ; / + c(0,4,2) = 0._RPP;c(1,4,2) = 0._RPP + ! / ; / + c(2,4,2) = 0._RPP;c(3,4,2) = 0._RPP + ! / ; / + c(4,4,2) = 11322353265._RPP/ 286802._RPP;c(5,4,2) = -7546651472._RPP/ 130969._RPP + ! / ; / + c(6,4,2) = 451561861._RPP/ 17139._RPP;c(7,4,2) = -2267814051._RPP/ 328385._RPP + ! / ; / + c(8,4,2) = 537364516._RPP/ 676097._RPP + + ! / ; / + c(0,5,2) = 0._RPP;c(1,5,2) = 0._RPP + ! / ; / + c(2,5,2) = 0._RPP;c(3,5,2) = 0._RPP + ! / ; / + c(4,5,2) = 0._RPP;c(5,5,2) = 3256858005._RPP/ 154108._RPP + ! / ; / + c(6,5,2) = -5961122741._RPP/ 307109._RPP;c(7,5,2) = 982680142._RPP/ 192447._RPP + ! / ; / + c(8,5,2) = -823497572._RPP/1397105._RPP + + ! / ; / + c(0,6,2) = 0._RPP;c(1,6,2) = 0._RPP + ! / ; / + c(2,6,2) = 0._RPP;c(3,6,2) = 0._RPP + ! / ; / + c(4,6,2) = 0._RPP;c(5,6,2) = 0._RPP + ! / ; / + c(6,6,2) = 2952652193._RPP/ 659941._RPP;c(7,6,2) = -1883344606._RPP/ 797417._RPP + ! / ; / + c(8,6,2) = 329649921._RPP/ 1205744._RPP + + ! / ; / + c(0,7,2) = 0._RPP;c(1,7,2) = 0._RPP + ! / ; / + c(2,7,2) = 0._RPP;c(3,7,2) = 0._RPP + ! / ; / + c(4,7,2) = 0._RPP;c(5,7,2) = 0._RPP + ! / ; / + c(6,7,2) = 0._RPP;c(7,7,2) = 267692197._RPP/856297._RPP + ! / ; / + c(8,7,2) = -178701734._RPP/ 2462661._RPP + + ! / ; / + c(0,8,2) = 0._RPP;c(1,8,2) = 0._RPP + ! / ; / + c(2,8,2) = 0._RPP;c(3,8,2) = 0._RPP + ! / ; / + c(4,8,2) = 0._RPP;c(5,8,2) = 0._RPP + ! / ; / + c(6,8,2) = 0._RPP;c(7,8,2) = 0._RPP + ! / ; / + c(8,8,2) = 14225607._RPP/ 3370285._RPP + + ! stencil 3 + ! / ; / + c(0,0,3) = 14225607._RPP/ 3370285._RPP;c(1,0,3) = -186193587._RPP/ 3061888._RPP + ! / ; / + c(2,0,3) = 103779883._RPP/544689._RPP;c(3,0,3) = -597649141._RPP/ 1759029._RPP + ! / ; / + c(4,0,3) = 348597468._RPP/ 922523._RPP;c(5,0,3) = -709458479._RPP/2638758._RPP + ! / ; / + c(6,0,3) = 184615935._RPP/1542601._RPP;c(7,0,3) = -417266048._RPP/13678797._RPP + ! / ; / + c(8,0,3) = 33222819._RPP/ 9738314._RPP + + ! / ; / + c(0,1,3) = 0._RPP;c(1,1,3) = 308180301._RPP/1366333._RPP + ! / ; / + c(2,1,3) = -522065981._RPP/ 360998._RPP;c(3,1,3) = 5590654438._RPP/ 2129495._RPP + ! / ; / + c(4,1,3) = -787874261._RPP/ 266082._RPP;c(5,1,3) = 1034492709._RPP/ 485618._RPP + ! / ; / + c(6,1,3) = -931274285._RPP/ 973468._RPP;c(7,1,3) = 544135101._RPP/ 2215768._RPP + ! / ; / + c(8,1,3) = -243832589._RPP/8827552._RPP + + ! / ; / + c(0,2,3) = 0._RPP;c(1,2,3) = 0._RPP + ! / ; / + c(2,2,3) = 2349998749._RPP/ 992475._RPP;c(3,2,3) = -3054791233._RPP/ 349036._RPP + ! / ; / + c(4,2,3) = 966000775._RPP/ 96443._RPP;c(5,2,3) = -828515195._RPP/ 113623._RPP + ! / ; / + c(6,2,3) = 1033739711._RPP/ 312683._RPP;c(7,2,3) = -767075415._RPP/ 896921._RPP + ! / ; / + c(8,2,3) = 83373698._RPP/861333._RPP + + ! / ; / + c(0,3,3) = 0._RPP;c(1,3,3) = 0._RPP + ! / ; / + c(2,3,3) = 0._RPP;c(3,3,3) = 1879971092._RPP/ 228557._RPP + ! / ; / + c(4,3,3) = -305554133._RPP/ 15991._RPP;c(5,3,3) = 3662929022._RPP/ 260087._RPP + ! / ; / + c(6,3,3) = -295058921._RPP/ 45739._RPP;c(7,3,3) = 654146656._RPP/ 388723._RPP + ! / ; / + c(8,3,3) = -135160981._RPP/704829._RPP + + ! / ; / + c(0,4,3) = 0._RPP;c(1,4,3) = 0._RPP + ! / ; / + c(2,4,3) = 0._RPP;c(3,4,3) = 0._RPP + ! / ; / + c(4,4,3) = 1548885060._RPP/ 137633._RPP;c(5,4,3) = -8099595796._RPP/ 482187._RPP + ! / ; / + c(6,4,3) = 1581790037._RPP/ 203396._RPP;c(7,4,3) = -6738238495._RPP/ 3291754._RPP + ! / ; / + c(8,4,3) = 85841095._RPP/ 365273._RPP + + ! / ; / + c(0,5,3) = 0._RPP;c(1,5,3) = 0._RPP + ! / ; / + c(2,5,3) = 0._RPP;c(3,5,3) = 0._RPP + ! / ; / + c(4,5,3) = 0._RPP;c(5,5,3) = 4054421226._RPP/ 639143._RPP + ! / ; / + c(6,5,3) = -628691758._RPP/ 105883._RPP;c(7,5,3) = 855538459._RPP/ 542278._RPP + ! / ; / + c(8,5,3) = -185363617._RPP/ 1015232._RPP + + ! / ; / + c(0,6,3) = 0._RPP;c(1,6,3) = 0._RPP + ! / ; / + c(2,6,3) = 0._RPP;c(3,6,3) = 0._RPP + ! / ; / + c(4,6,3) = 0._RPP;c(5,6,3) = 0._RPP + ! / ; / + c(6,6,3) = 2253530669._RPP/ 1605103._RPP;c(7,6,3) = -491966393._RPP/ 653081._RPP + ! / ; / + c(8,6,3) = 67366110._RPP/766169._RPP + + ! / ; / + c(0,7,3) = 0._RPP;c(1,7,3) = 0._RPP + ! / ; / + c(2,7,3) = 0._RPP;c(3,7,3) = 0._RPP + ! / ; / + c(4,7,3) = 0._RPP;c(5,7,3) = 0._RPP + ! / ; / + c(6,7,3) = 0._RPP;c(7,7,3) = 193935861._RPP/1901234._RPP + ! / ; / + c(8,7,3) = -28933143._RPP/ 1204235._RPP + + ! / ; / + c(0,8,3) = 0._RPP;c(1,8,3) = 0._RPP + ! / ; / + c(2,8,3) = 0._RPP;c(3,8,3) = 0._RPP + ! / ; / + c(4,8,3) = 0._RPP;c(5,8,3) = 0._RPP + ! / ; / + c(6,8,3) = 0._RPP;c(7,8,3) = 0._RPP + ! / ; / + c(8,8,3) = 25595175._RPP/ 17925332._RPP + + ! stencil 4 + ! / ; / + c(0,0,4) = 25595175._RPP/ 17925332._RPP;c(1,0,4) = -471882251._RPP/ 21169910._RPP + ! / ; / + c(2,0,4) = 48978927._RPP/ 651442._RPP;c(3,0,4) = -81991005._RPP/573014._RPP + ! / ; / + c(4,0,4) = 323192477._RPP/ 1923068._RPP;c(5,0,4) = -247486780._RPP/1982753._RPP + ! / ; / + c(6,0,4) = 179193514._RPP/3127239._RPP;c(7,0,4) = -42281552._RPP/ 2841263._RPP + ! / ; / + c(8,0,4) = 21701959._RPP/12951510._RPP + + ! / ; / + c(0,1,4) = 0._RPP;c(1,1,4) = 206821378._RPP/2319277._RPP + ! / ; / + c(2,1,4) = -257255959._RPP/ 418532._RPP;c(3,1,4) = 1066785823._RPP/ 895146._RPP + ! / ; / + c(4,1,4) = -659953893._RPP/ 463955._RPP;c(5,1,4) = 889068808._RPP/ 829823._RPP + ! / ; / + c(6,1,4) = -379006664._RPP/ 761061._RPP;c(7,1,4) = 145478651._RPP/ 1112277._RPP + ! / ; / + c(8,1,4) = -42281552._RPP/ 2841263._RPP + + ! / ; / + c(0,2,4) = 0._RPP;c(1,2,4) = 0._RPP + ! / ; / + c(2,2,4) = 467443989._RPP/ 432139._RPP;c(3,2,4) = -1014379655._RPP/ 237166._RPP + ! / ; / + c(4,2,4) = 1427976276._RPP/ 274865._RPP;c(5,2,4) = -1288674710._RPP/ 324261._RPP + ! / ; / + c(6,2,4) = 56509897._RPP/ 30173._RPP;c(7,2,4) = -379006664._RPP/ 761061._RPP + ! / ; / + c(8,2,4) = 179193514._RPP/3127239._RPP + + ! / ; / + c(0,3,4) = 0._RPP;c(1,3,4) = 0._RPP + ! / ; / + c(2,3,4) = 0._RPP;c(3,3,4) = 1224163507._RPP/ 283894._RPP + ! / ; / + c(4,3,4) = -1890391470._RPP/ 177121._RPP;c(5,3,4) = 2682354099._RPP/ 322987._RPP + ! / ; / + c(6,3,4) = -1288674710._RPP/ 324261._RPP;c(7,3,4) = 889068808._RPP/ 829823._RPP + ! / ; / + c(8,3,4) = -247486780._RPP/1982753._RPP + + ! / ; / + c(0,4,4) = 0._RPP;c(1,4,4) = 0._RPP + ! / ; / + c(2,4,4) = 0._RPP;c(3,4,4) = 0._RPP + ! / ; / + c(4,4,4) = 7446840373._RPP/ 1106172._RPP;c(5,4,4) = -1890391470._RPP/ 177121._RPP + ! / ; / + c(6,4,4) = 1427976276._RPP/ 274865._RPP;c(7,4,4) = -659953893._RPP/ 463955._RPP + ! / ; / + c(8,4,4) = 323192477._RPP/ 1923068._RPP + + ! / ; / + c(0,5,4) = 0._RPP;c(1,5,4) = 0._RPP + ! / ; / + c(2,5,4) = 0._RPP;c(3,5,4) = 0._RPP + ! / ; / + c(4,5,4) = 0._RPP;c(5,5,4) = 1224163507._RPP/ 283894._RPP + ! / ; / + c(6,5,4) = -1014379655._RPP/ 237166._RPP;c(7,5,4) = 1066785823._RPP/ 895146._RPP + ! / ; / + c(8,5,4) = -81991005._RPP/573014._RPP + + ! / ; / + c(0,6,4) = 0._RPP;c(1,6,4) = 0._RPP + ! / ; / + c(2,6,4) = 0._RPP;c(3,6,4) = 0._RPP + ! / ; / + c(4,6,4) = 0._RPP;c(5,6,4) = 0._RPP + ! / ; / + c(6,6,4) = 467443989._RPP/ 432139._RPP;c(7,6,4) = -257255959._RPP/ 418532._RPP + ! / ; / + c(8,6,4) = 48978927._RPP/ 651442._RPP + + ! / ; / + c(0,7,4) = 0._RPP;c(1,7,4) = 0._RPP + ! / ; / + c(2,7,4) = 0._RPP;c(3,7,4) = 0._RPP + ! / ; / + c(4,7,4) = 0._RPP;c(5,7,4) = 0._RPP + ! / ; / + c(6,7,4) = 0._RPP;c(7,7,4) = 206821378._RPP/2319277._RPP + ! / ; / + c(8,7,4) = -471882251._RPP/ 21169910._RPP + + ! / ; / + c(0,8,4) = 0._RPP;c(1,8,4) = 0._RPP + ! / ; / + c(2,8,4) = 0._RPP;c(3,8,4) = 0._RPP + ! / ; / + c(4,8,4) = 0._RPP;c(5,8,4) = 0._RPP + ! / ; / + c(6,8,4) = 0._RPP;c(7,8,4) = 0._RPP + ! / ; / + c(8,8,4) = 25595175._RPP/ 17925332._RPP + + ! stencil 5 + ! / ; / + c(0,0,5) = 25595175._RPP/ 17925332._RPP;c(1,0,5) = -28933143._RPP/ 1204235._RPP + ! / ; / + c(2,0,5) = 67366110._RPP/766169._RPP;c(3,0,5) = -185363617._RPP/ 1015232._RPP + ! / ; / + c(4,0,5) = 85841095._RPP/ 365273._RPP;c(5,0,5) = -135160981._RPP/704829._RPP + ! / ; / + c(6,0,5) = 83373698._RPP/861333._RPP;c(7,0,5) = -243832589._RPP/8827552._RPP + ! / ; / + c(8,0,5) = 33222819._RPP/ 9738314._RPP + + ! / ; / + c(0,1,5) = 0._RPP;c(1,1,5) = 193935861._RPP/1901234._RPP + ! / ; / + c(2,1,5) = -491966393._RPP/ 653081._RPP;c(3,1,5) = 855538459._RPP/ 542278._RPP + ! / ; / + c(4,1,5) = -6738238495._RPP/ 3291754._RPP;c(5,1,5) = 654146656._RPP/ 388723._RPP + ! / ; / + c(6,1,5) = -767075415._RPP/ 896921._RPP;c(7,1,5) = 544135101._RPP/ 2215768._RPP + ! / ; / + c(8,1,5) = -417266048._RPP/13678797._RPP + + ! / ; / + c(0,2,5) = 0._RPP;c(1,2,5) = 0._RPP + ! / ; / + c(2,2,5) = 2253530669._RPP/ 1605103._RPP;c(3,2,5) = -628691758._RPP/ 628691758._RPP + ! / ; / + c(4,2,5) = 1581790037._RPP/ 203396._RPP;c(5,2,5) = -295058921._RPP/ 45739._RPP + ! / ; / + c(6,2,5) = 1033739711._RPP/ 312683._RPP;c(7,2,5) = -931274285._RPP/ 973468._RPP + ! / ; / + c(8,2,5) = 184615935._RPP/1542601._RPP + + ! / ; / + c(0,3,5) = 0._RPP;c(1,3,5) = 0._RPP + ! / ; / + c(2,3,5) = 0._RPP;c(3,3,5) = 4054421226._RPP/ 639143._RPP + ! / ; / + c(4,3,5) = -8099595796._RPP/ 482187._RPP;c(5,3,5) = 3662929022._RPP/ 260087._RPP + ! / ; / + c(6,3,5) = -828515195._RPP/ 113623._RPP;c(7,3,5) = 1034492709._RPP/ 485618._RPP + ! / ; / + c(8,3,5) = -709458479._RPP/2638758._RPP + + ! / ; / + c(0,4,5) = 0._RPP;c(1,4,5) = 0._RPP + ! / ; / + c(2,4,5) = 0._RPP;c(3,4,5) = 0._RPP + ! / ; / + c(4,4,5) = 1548885060._RPP/ 137633._RPP;c(5,4,5) = -305554133._RPP/ 15991._RPP + ! / ; / + c(6,4,5) = 966000775._RPP/ 96443._RPP;c(7,4,5) = -787874261._RPP/ 266082._RPP + ! / ; / + c(8,4,5) = 348597468._RPP/ 922523._RPP + + ! / ; / + c(0,5,5) = 0._RPP;c(1,5,5) = 0._RPP + ! / ; / + c(2,5,5) = 0._RPP;c(3,5,5) = 0._RPP + ! / ; / + c(4,5,5) = 0._RPP;c(5,5,5) = 1879971092._RPP/ 228557._RPP + ! / ; / + c(6,5,5) = -3054791233._RPP/ 349036._RPP;c(7,5,5) = 5590654438._RPP/ 2129495._RPP + ! / ; / + c(8,5,5) = -597649141._RPP/ 1759029._RPP + + ! / ; / + c(0,6,5) = 0._RPP;c(1,6,5) = 0._RPP + ! / ; / + c(2,6,5) = 0._RPP;c(3,6,5) = 0._RPP + ! / ; / + c(4,6,5) = 0._RPP;c(5,6,5) = 0._RPP + ! / ; / + c(6,6,5) = 2349998749._RPP/ 992475._RPP;c(7,6,5) = -522065981._RPP/ 360998._RPP + ! / ; / + c(8,6,5) = 103779883._RPP/544689._RPP + + ! / ; / + c(0,7,5) = 0._RPP;c(1,7,5) = 0._RPP + ! / ; / + c(2,7,5) = 0._RPP;c(3,7,5) = 0._RPP + ! / ; / + c(4,7,5) = 0._RPP;c(5,7,5) = 0._RPP + ! / ; / + c(6,7,5) = 0._RPP;c(7,7,5) = 308180301._RPP/1366333._RPP + ! / ; / + c(8,7,5) = -186193587._RPP/ 3061888._RPP + + ! / ; / + c(0,8,5) = 0._RPP;c(1,8,5) = 0._RPP + ! / ; / + c(2,8,5) = 0._RPP;c(3,8,5) = 0._RPP + ! / ; / + c(4,8,5) = 0._RPP;c(5,8,5) = 0._RPP + ! / ; / + c(6,8,5) = 0._RPP;c(7,8,5) = 0._RPP + ! / ; / + c(8,8,5) = 14225607._RPP/ 3370285._RPP + + ! stencil 6 + ! / ; / + c(0,0,6) = 14225607._RPP/ 3370285._RPP;c(1,0,6) = -178701734._RPP/ 2462661._RPP + ! / ; / + c(2,0,6) = 329649921._RPP/ 1205744._RPP;c(3,0,6) = -823497572._RPP/1397105._RPP + ! / ; / + c(4,0,6) = 537364516._RPP/ 676097._RPP;c(5,0,6) = -427576737._RPP/623480._RPP + ! / ; / + c(6,0,6) = 383212815._RPP/1037536._RPP;c(7,0,6) = -264553111._RPP/ 2333462._RPP + ! / ; / + c(8,0,6) = 265338548._RPP/17495633._RPP + + ! / ; / + c(0,1,6) = 0._RPP;c(1,1,6) = 267692197._RPP/856297._RPP + ! / ; / + c(2,1,6) = -1883344606._RPP/ 797417._RPP;c(3,1,6) = 982680142._RPP/ 192447._RPP + ! / ; / + c(4,1,6) = -2267814051._RPP/ 328385._RPP;c(5,1,6) = 1268411423._RPP/ 212206._RPP + ! / ; / + c(6,1,6) = -676787627._RPP/ 209575._RPP;c(7,1,6) = 127754174._RPP/ 128481._RPP + ! / ; / + c(8,1,6) = -173397370._RPP/1299717._RPP + + ! / ; / + c(0,2,6) = 0._RPP;c(1,2,6) = 0._RPP + ! / ; / + c(2,2,6) = 2952652193._RPP/ 659941._RPP;c(3,2,6) = -5961122741._RPP/ 307109._RPP + ! / ; / + c(4,2,6) = 451561861._RPP/ 17139._RPP;c(5,2,6) = -2468363819._RPP/ 107827._RPP + ! / ; / + c(6,2,6) = 2097415117._RPP/ 168915._RPP;c(7,2,6) = -2367490577._RPP/ 616772._RPP + ! / ; / + c(8,2,6) = 688214053._RPP/1331147._RPP + + ! / ; / + c(0,3,6) = 0._RPP;c(1,3,6) = 0._RPP + ! / ; / + c(2,3,6) = 0._RPP;c(3,3,6) = 3256858005._RPP/ 154108._RPP + ! / ; / + c(4,3,6) = -7546651472._RPP/ 130969._RPP;c(5,3,6) = 3655479387._RPP/ 72668._RPP + ! / ; / + c(6,3,6) = -765629878._RPP/ 27919._RPP;c(7,3,6) = 5241495620._RPP/ 615127._RPP + ! / ; / + c(8,3,6) = -61463934._RPP/53285._RPP + + ! / ; / + c(0,4,6) = 0._RPP;c(1,4,6) = 0._RPP + ! / ; / + c(2,4,6) = 0._RPP;c(3,4,6) = 0._RPP + ! / ; / + c(4,4,6) = 11322353265._RPP/ 286802._RPP;c(5,4,6) = -4882065990._RPP/ 70417._RPP + ! / ; / + c(6,4,6) = 1334723167._RPP/ 35090._RPP;c(7,4,6) = -10107954583._RPP/ 849559._RPP + ! / ; / + c(8,4,6) = 306856831._RPP/ 189251._RPP + + ! / ; / + c(0,5,6) = 0._RPP;c(1,5,6) = 0._RPP + ! / ; / + c(2,5,6) = 0._RPP;c(3,5,6) = 0._RPP + ! / ; / + c(4,5,6) = 0._RPP;c(5,5,6) = 2631362108._RPP/ 85845._RPP + ! / ; / + c(6,5,6) = -2028942806._RPP/ 59843._RPP;c(7,5,6) = 2363787227._RPP/ 220958._RPP + ! / ; / + c(8,5,6) = -289784372._RPP/196989._RPP + + ! / ; / + c(0,6,6) = 0._RPP;c(1,6,6) = 0._RPP + ! / ; / + c(2,6,6) = 0._RPP;c(3,6,6) = 0._RPP + ! / ; / + c(4,6,6) = 0._RPP;c(5,6,6) = 0._RPP + ! / ; / + c(6,6,6) = 3248190394._RPP/ 343067._RPP;c(7,6,6) = -1651888798._RPP/ 273307._RPP + ! / ; / + c(8,6,6) = 277579576._RPP/329887._RPP + + ! / ; / + c(0,7,6) = 0._RPP;c(1,7,6) = 0._RPP + ! / ; / + c(2,7,6) = 0._RPP;c(3,7,6) = 0._RPP + ! / ; / + c(4,7,6) = 0._RPP;c(5,7,6) = 0._RPP + ! / ; / + c(6,7,6) = 0._RPP;c(7,7,6) = 526012837._RPP/537300._RPP + ! / ; / + c(8,7,6) = -699447262._RPP/ 2521667._RPP + + ! / ; / + c(0,8,6) = 0._RPP;c(1,8,6) = 0._RPP + ! / ; / + c(2,8,6) = 0._RPP;c(3,8,6) = 0._RPP + ! / ; / + c(4,8,6) = 0._RPP;c(5,8,6) = 0._RPP + ! / ; / + c(6,8,6) = 0._RPP;c(7,8,6) = 0._RPP + ! / ; / + c(8,8,6) = 36409563._RPP/ 1806520._RPP + + ! stencil 7 + ! / ; / + c(0,0,7) = 36409563._RPP/ 1806520._RPP;c(1,0,7) = -296572045._RPP/ 853161._RPP + ! / ; / + c(2,0,7) = 1414733955._RPP/1073627._RPP;c(3,0,7) = -557744521._RPP/194407._RPP + ! / ; / + c(4,0,7) = 1990119523._RPP/ 506979._RPP;c(5,0,7) = -1275601375._RPP/368936._RPP + ! / ; / + c(6,0,7) = 2064497172._RPP/1078127._RPP;c(7,0,7) = -759205271._RPP/1245236._RPP + ! / ; / + c(8,0,7) = 192493416._RPP/2253847._RPP + + ! / ; / + c(0,1,7) = 0._RPP;c(1,1,7) = 550334507._RPP/ 366830._RPP + ! / ; / + c(2,1,7) = -1486183058._RPP/ 130527._RPP;c(3,1,7) = 1696424402._RPP/ 68349._RPP + ! / ; / + c(4,1,7) = -5136703769._RPP/ 151046._RPP;c(5,1,7) = 2675355119._RPP/ 89174._RPP + ! / ; / + c(6,1,7) = -2519869819._RPP/ 151381._RPP;c(7,1,7) = 1632642660._RPP/ 307433._RPP + ! / ; / + c(8,1,7) = -433682386._RPP/ 581703._RPP + + ! / ; / + c(0,2,7) = 0._RPP;c(1,2,7) = 0._RPP + ! / ; / + c(2,2,7) = 3171898228._RPP/ 146643._RPP;c(3,2,7) = -7652084383._RPP/ 81028._RPP + ! / ; / + c(4,2,7) = 4693138545._RPP/ 36209._RPP;c(5,2,7) = -5737609802._RPP/ 50081._RPP + ! / ; / + c(6,2,7) = 2904329890._RPP/ 45589._RPP;c(7,2,7) = -684405583._RPP/ 33590._RPP + ! / ; / + c(8,2,7) = 1206026846._RPP/420471._RPP + + ! / ; / + c(0,3,7) = 0._RPP;c(1,3,7) = 0._RPP + ! / ; / + c(2,3,7) = 0._RPP;c(3,3,7) = 10194856899._RPP/ 98734._RPP + ! / ; / + c(4,3,7) = -32956224478._RPP/ 116041._RPP;c(5,3,7) = 21903079582._RPP/ 87043._RPP + ! / ; / + c(6,3,7) = -30871077827._RPP/ 220014._RPP;c(7,3,7) = 2631734550._RPP/ 58459._RPP + ! / ; / + c(8,3,7) = -1432715713._RPP/225284._RPP + + ! / ; / + c(0,4,7) = 0._RPP;c(1,4,7) = 0._RPP + ! / ; / + c(2,4,7) = 0._RPP;c(3,4,7) = 0._RPP + ! / ; / + c(4,4,7) = 5232843359._RPP/ 26730._RPP;c(5,4,7) = -21436202114._RPP/ 61611._RPP + ! / ; / + c(6,4,7) = 8450768743._RPP/ 43407._RPP;c(7,4,7) = -2463944763._RPP/ 39286._RPP + ! / ; / + c(8,4,7) = 2318146475._RPP/ 260443._RPP + + ! / ; / + c(0,5,7) = 0._RPP;c(1,5,7) = 0._RPP + ! / ; / + c(2,5,7) = 0._RPP;c(3,5,7) = 0._RPP + ! / ; / + c(4,5,7) = 0._RPP;c(5,5,7) = 7222761881._RPP/ 46553._RPP + ! / ; / + c(6,5,7) = -12258216466._RPP/ 70285._RPP;c(7,5,7) = 17759778441._RPP/ 314408._RPP + ! / ; / + c(8,5,7) = -351689199._RPP/43600._RPP + + ! / ; / + c(0,6,7) = 0._RPP;c(1,6,7) = 0._RPP + ! / ; / + c(2,6,7) = 0._RPP;c(3,6,7) = 0._RPP + ! / ; / + c(4,6,7) = 0._RPP;c(5,6,7) = 0._RPP + ! / ; / + c(6,6,7) = 138686396638._RPP/ 2813507._RPP;c(7,6,7) = -6349489117._RPP/ 197436._RPP + ! / ; / + c(8,6,7) = 1919279425._RPP/ 414313._RPP + + ! / ; / + c(0,7,7) = 0._RPP;c(1,7,7) = 0._RPP + ! / ; / + c(2,7,7) = 0._RPP;c(3,7,7) = 0._RPP + ! / ; / + c(4,7,7) = 0._RPP;c(5,7,7) = 0._RPP + ! / ; / + c(6,7,7) = 0._RPP;c(7,7,7) = 8788336457._RPP/1659246._RPP + ! / ; / + c(8,7,7) = -1605498941._RPP/ 1038640._RPP + + ! / ; / + c(0,8,7) = 0._RPP;c(1,8,7) = 0._RPP + ! / ; / + c(2,8,7) = 0._RPP;c(3,8,7) = 0._RPP + ! / ; / + c(4,8,7) = 0._RPP;c(5,8,7) = 0._RPP + ! / ; / + c(6,8,7) = 0._RPP;c(7,8,7) = 0._RPP + ! / ; / + c(8,8,7) = 23000337._RPP/ 199768._RPP + + ! stencil 8 + ! / ; / + c(0,0,8) = 23000337._RPP/ 199768._RPP;c(1,0,8) = -989259649._RPP/ 497859._RPP + ! / ; / + c(2,0,8) = 2005851423._RPP/265880._RPP;c(3,0,8) = -800361473._RPP/ 48582._RPP + ! / ; / + c(4,0,8) = 1211629703._RPP/ 53483._RPP;c(5,0,8) = -16400242834._RPP/815393._RPP + ! / ; / + c(6,0,8) = 2160095091._RPP/191558._RPP;c(7,0,8) = -1039356853._RPP/284187._RPP + ! / ; / + c(8,0,8) = 380112881._RPP/ 721737._RPP + + ! / ; / + c(0,1,8) = 0._RPP;c(1,1,8) = 1207396129._RPP/140764._RPP + ! / ; / + c(2,1,8) = -5910597075._RPP/ 90694._RPP;c(3,1,8) = 6203677189._RPP/ 43561._RPP + ! / ; / + c(4,1,8) = -29831101642._RPP/ 152201._RPP;c(5,1,8) = 8534140303._RPP/ 48995._RPP + ! / ; / + c(6,1,8) = -7469836609._RPP/ 76401._RPP;c(7,1,8) = 962141663._RPP/ 30298._RPP + ! / ; / + c(8,1,8) = -1382011106._RPP/301683._RPP + + ! / ; / + c(0,2,8) = 0._RPP;c(1,2,8) = 0._RPP + ! / ; / + c(2,2,8) = 9873545067._RPP/ 79705._RPP;c(3,2,8) = -10120501295._RPP/ 18678._RPP + ! / ; / + c(4,2,8) = 9817971019._RPP/ 13153._RPP;c(5,2,8) = -13534679320._RPP/ 20379._RPP + ! / ; / + c(6,2,8) = 8640690184._RPP/ 23145._RPP;c(7,2,8) = -7097325924._RPP/ 58429._RPP + ! / ; / + c(8,2,8) = 7116193241._RPP/405236._RPP + + ! / ; / + c(0,3,8) = 0._RPP;c(1,3,8) = 0._RPP + ! / ; / + c(2,3,8) = 0._RPP;c(3,3,8) = 181942554161._RPP/ 306771._RPP + ! / ; / + c(4,3,8) = -32852743324._RPP/ 20081._RPP;c(5,3,8) = 25425670807._RPP/ 17442._RPP + ! / ; / + c(6,3,8) = -13491549889._RPP/ 16436._RPP;c(7,3,8) = 13666821827._RPP/ 51060._RPP + ! / ; / + c(8,3,8) = -12858081715._RPP/331389._RPP + + ! / ; / + c(0,4,8) = 0._RPP;c(1,4,8) = 0._RPP + ! / ; / + c(2,4,8) = 0._RPP;c(3,4,8) = 0._RPP + ! / ; / + c(4,4,8) = 7211727349._RPP/ 6383._RPP;c(5,4,8) = -34046474687._RPP/ 16880._RPP + ! / ; / + c(6,4,8) = 29334155111._RPP/ 25771._RPP;c(7,4,8) = -14121568547._RPP/ 37942._RPP + ! / ; / + c(8,4,8) = 8028408627._RPP/ 148285._RPP + + ! / ; / + c(0,5,8) = 0._RPP;c(1,5,8) = 0._RPP + ! / ; / + c(2,5,8) = 0._RPP;c(3,5,8) = 0._RPP + ! / ; / + c(4,5,8) = 0._RPP;c(5,5,8) = 26479157148._RPP/ 29351._RPP + ! / ; / + c(6,5,8) = -32612776236._RPP/ 31939._RPP;c(7,5,8) = 10624327325._RPP/ 31707._RPP + ! / ; / + c(8,5,8) = -6519672839._RPP/ 133134._RPP + + ! / ; / + c(0,6,8) = 0._RPP;c(1,6,8) = 0._RPP + ! / ; / + c(2,6,8) = 0._RPP;c(3,6,8) = 0._RPP + ! / ; / + c(4,6,8) = 0._RPP;c(5,6,8) = 0._RPP + ! / ; / + c(6,6,8) = 958711850795._RPP/ 3306139._RPP;c(7,6,8) = -2523726139._RPP/ 13197._RPP + ! / ; / + c(8,6,8) = 1051885279._RPP/37394._RPP + + ! / ; / + c(0,7,8) = 0._RPP;c(1,7,8) = 0._RPP + ! / ; / + c(2,7,8) = 0._RPP;c(3,7,8) = 0._RPP + ! / ; / + c(4,7,8) = 0._RPP;c(5,7,8) = 0._RPP + ! / ; / + c(6,7,8) = 0._RPP;c(7,7,8) = 2789709824._RPP/ 87891._RPP + ! / ; / + c(8,7,8) = -1291706883._RPP/ 137012._RPP + + ! / ; / + c(0,8,8) = 0._RPP;c(1,8,8) = 0._RPP + ! / ; / + c(2,8,8) = 0._RPP;c(3,8,8) = 0._RPP + ! / ; / + c(4,8,8) = 0._RPP;c(5,8,8) = 0._RPP + ! / ; / + c(6,8,8) = 0._RPP;c(7,8,8) = 0._RPP + ! / ; / + c(8,8,8) = 191906863._RPP/ 270061._RPP + endselect + endassociate + endsubroutine create + + pure subroutine compute(self, stencil) + !< Compute beta. + class(beta_int_js), intent(inout) :: self !< Beta. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + integer(I_P) :: s1, s2, s3, f !< Counters. + + do s1=0, self%S - 1 ! stencils loop + do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + self%values(f, s1) = 0._RPP + do s2=0, self%S - 1 + do s3=0, self%S - 1 + self%values(f, s1) = self%values(f, s1) + & + self%coef(s3, s2, s1) * stencil(f + self%ff, s1 - s3) * stencil(f + self%ff, s1 - s2) + enddo + enddo + enddo + enddo + endsubroutine compute + + pure function description(self) result(string) + !< Return beta string-description. + class(beta_int_js), intent(in) :: self !< Beta. + character(len=:), allocatable :: string !< String-description. + +#ifndef DEBUG + ! error stop in pure procedure is a F2015 feature not yet supported in debug mode + error stop 'beta_int_js%description to be implemented, do not use!' +#endif + endfunction description + + elemental subroutine destroy(self) + !< Destroy beta. + class(beta_int_js), intent(inout) :: self !< Beta. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + if (allocated(self%coef)) deallocate(self%coef) + endsubroutine destroy +endmodule wenoof_beta_int_js From b409be44a9f6ef7c4e571e9030e395ed092ec80d Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 6 Feb 2017 18:39:54 +0100 Subject: [PATCH 04/90] Add factories for weno interpolation. Short description Why: * This change addresses the need by: * Side effects: * --- .../wenoof_interpolator_js.F90 | 82 ++++++++++++++----- .../wenoof_reconstructor_js.F90 | 4 +- src/lib/factories/wenoof_beta_factory.f90 | 12 ++- .../wenoof_interpolations_factory.f90 | 6 +- .../factories/wenoof_interpolator_factory.f90 | 15 ++-- src/lib/factories/wenoof_kappa_factory.f90 | 12 ++- 6 files changed, 99 insertions(+), 32 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index 3e9109c..88a3cab 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -8,7 +8,12 @@ module wenoof_interpolator_js #else use penf, only: RPP=>R8P #endif +use wenoof_base_object +use wenoof_interpolations_factory +use wenoof_interpolations_object use wenoof_interpolator_object +use wenoof_weights_factory +use wenoof_weights_object implicit none private @@ -21,39 +26,61 @@ module wenoof_interpolator_js type, extends(interpolator_object) :: interpolator_js !< Jiang-Shu (upwind) interpolator object. + !< + !< @note Provide the *High Order Weighted Essentially Nonoscillatory Schemes for Convection Dominated Problems*, + !< Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, doi:10.1137/070679065. + !< + !< @note The supported accuracy formal order are: 3rd, 5th, 7th, 9th, 11th, 13th, 15th, 17th corresponding to use 2, 3, 4, 5, 6, + !< 7, 8, 9 stencils composed of 2, 3, 4, 5, 6, 7, 8, 9 values, respectively. contains ! public deferred methods + procedure, pass(self) :: create !< Create interpolator. procedure, pass(self) :: description !< Return interpolator string-description. + procedure, pass(self) :: destroy !< Destroy interpolator. procedure, pass(self) :: interpolate_standard !< Interpolate values (without providing debug values). procedure, pass(self) :: interpolate_debug !< Interpolate values (providing also debug values). endtype interpolator_js contains ! public deferred methods + subroutine create(self, constructor) + !< Create interpolator. + class(interpolator_js), intent(inout) :: self !< Interpolator. + class(base_object_constructor), intent(in) :: constructor !< Constructor. + type(interpolations_factory) :: i_factory !< Inteprolations factory. + type(weights_factory) :: w_factory !< Weights factory. + + call self%destroy + call self%create_(constructor=constructor) + select type(constructor) + class is(interpolator_object_constructor) + call i_factory%create(constructor=constructor%interpolations_constructor, object=self%interpolations) + call w_factory%create(constructor=constructor%weights_constructor, object=self%weights) + endselect + endsubroutine create + pure function description(self) result(string) !< Return interpolator string-descripition. class(interpolator_js), intent(in) :: self !< Interpolator. character(len=:), allocatable :: string !< String-description. character(len=1), parameter :: nl=new_line('a') !< New line character. - character(len=:), allocatable :: dummy_string !< Dummy string. -#ifndef DEBUG - ! error stop in pure procedure is a F2015 feature not yet supported in debug mode - error stop 'interpolator_js to be implemented, do not use!' -#endif + string = 'Jiang-Shu reconstructor:'//nl + string = string//' - S = '//trim(str(self%S))//nl + string = string//' - f1 = '//trim(str(self%f1))//nl + string = string//' - f2 = '//trim(str(self%f2))//nl + string = string//' - ff = '//trim(str(self%ff))//nl + string = string//self%weights%description() endfunction description - pure subroutine interpolate_standard(self, stencil, interpolation) - !< Interpolate values (without providing debug values). - class(interpolator_js), intent(inout) :: self !< Interpolator. - real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. - real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. + elemental subroutine destroy(self) + !< Destroy interpolator. + class(interpolator_js), intent(inout) :: self !< Interpolator. -#ifndef DEBUG - ! error stop in pure procedure is a F2015 feature not yet supported in debug mode - error stop 'interpolator_js to be implemented, do not use!' -#endif - endsubroutine interpolate_standard + call self%destroy_ + if (allocated(self%interpolations)) deallocate(self%interpolations) + if (allocated(self%weights)) deallocate(self%weights) + endsubroutine destroy pure subroutine interpolate_debug(self, stencil, interpolation, si, weights) !< Interpolate values (providing also debug values). @@ -63,9 +90,26 @@ pure subroutine interpolate_debug(self, stencil, interpolation, si, weights) real(RPP), intent(out) :: si(1:, 0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. real(RPP), intent(out) :: weights(1:, 0:) !< Weights of the stencils, [1:2, 0:S-1]. -#ifndef DEBUG - ! error stop in pure procedure is a F2015 feature not yet supported in debug mode - error stop 'interpolator_js to be implemented, do not use!' -#endif + call self%interpolate_standard(stencil=stencil, interpolation=interpolation) + si = self%weights%smoothness_indicators() + weights = self%weights%values endsubroutine interpolate_debug + + pure subroutine interpolate_standard(self, stencil, interpolation) + !< Interpolate values (without providing debug values). + class(interpolator_js), intent(inout) :: self !< Interpolator. + real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. + real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. + integer(I_P) :: f, s !< Counters. + + call self%interpolations%compute(stencil=stencil) + call self%weights%compute(stencil=stencil) + interpolation = 0._RPP + do s=0, self%S - 1 ! stencils loop + do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + interpolation(f + self%ff) = interpolation(f + self%ff) + & + self%weights%values(f + self%ff, s) * self%interpolations%values(f, s) + enddo + enddo + endsubroutine interpolate_standard endmodule wenoof_interpolator_js diff --git a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 index 8ec06bb..240cfed 100644 --- a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 +++ b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 @@ -44,8 +44,8 @@ module wenoof_reconstructor_js contains ! public deferred methods subroutine create(self, constructor) - !< Create interpolator. - class(reconstructor_js), intent(inout) :: self !< Interpolator. + !< Create reconstructor. + class(reconstructor_js), intent(inout) :: self !< Reconstructor. class(base_object_constructor), intent(in) :: constructor !< Constructor. type(interpolations_factory) :: i_factory !< Inteprolations factory. type(weights_factory) :: w_factory !< Weights factory. diff --git a/src/lib/factories/wenoof_beta_factory.f90 b/src/lib/factories/wenoof_beta_factory.f90 index 65eb7a4..ab1c213 100644 --- a/src/lib/factories/wenoof_beta_factory.f90 +++ b/src/lib/factories/wenoof_beta_factory.f90 @@ -5,6 +5,7 @@ module wenoof_beta_factory use penf, only: I_P use wenoof_beta_object use wenoof_beta_rec_js +use wenoof_beta_int_js implicit none private @@ -27,6 +28,8 @@ subroutine create(constructor, object) select type(constructor) type is(beta_rec_js_constructor) allocate(beta_rec_js :: object) + type is(beta_int_js_constructor) + allocate(beta_int_js :: object) class default error stop 'error: WenOOF object factory do NOT know the constructor given' endselect @@ -43,8 +46,13 @@ subroutine create_constructor(interpolator_type, S, constructor, face_left, face select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - ! @TODO implement this - error stop 'interpolator-JS to be implemented' + allocate(beta_int_js_constructor :: constructor) + case('interpolator-M-JS') + allocate(beta_int_js_constructor :: constructor) + case('interpolator-M-Z') + allocate(beta_int_js_constructor :: constructor) + case('interpolator-Z') + allocate(beta_int_js_constructor :: constructor) case('reconstructor-JS') allocate(beta_rec_js_constructor :: constructor) case('reconstructor-M-JS') diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index 689ad0c..de0228a 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -5,6 +5,7 @@ module wenoof_interpolations_factory use penf, only: I_P use wenoof_interpolations_object use wenoof_interpolations_rec_js +use wenoof_interpolations_int_js implicit none private @@ -25,6 +26,8 @@ subroutine create(constructor, object) class(interpolations_object), allocatable, intent(out) :: object !< Object. select type(constructor) + type is(interpolations_int_js_constructor) + allocate(interpolations_int_js :: object) type is(interpolations_rec_js_constructor) allocate(interpolations_rec_js :: object) class default @@ -43,8 +46,7 @@ subroutine create_constructor(interpolator_type, S, constructor, face_left, face select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - ! @TODO implement this - error stop 'interpolator-JS to be implemented' + allocate(interpolations_int_js_constructor :: constructor) case('reconstructor-JS') allocate(interpolations_rec_js_constructor :: constructor) case('reconstructor-M-JS') diff --git a/src/lib/factories/wenoof_interpolator_factory.f90 b/src/lib/factories/wenoof_interpolator_factory.f90 index ba7cfb6..0b984d4 100644 --- a/src/lib/factories/wenoof_interpolator_factory.f90 +++ b/src/lib/factories/wenoof_interpolator_factory.f90 @@ -5,7 +5,7 @@ module wenoof_interpolator_factory use penf, only: I_P use wenoof_interpolations_object use wenoof_interpolator_object -! use wenoof_interpolator_js +use wenoof_interpolator_js use wenoof_reconstructor_js use wenoof_weights_object @@ -28,8 +28,8 @@ subroutine create(constructor, object) class(interpolator_object), allocatable, intent(out) :: object !< Object. select type(constructor) - ! type is(interpolator_js_constructor) - ! allocate(interpolator_js :: object) + type is(interpolator_js_constructor) + allocate(interpolator_js :: object) type is(reconstructor_js_constructor) allocate(reconstructor_js :: object) class default @@ -51,8 +51,13 @@ subroutine create_constructor(interpolator_type, S, interpolations_constructor, select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - ! @TODO implement this - error stop 'interpolator-JS to be implemented' + allocate(interpolator_js_constructor :: constructor) + case('interpolator-M-JS') + allocate(interpolator_js_constructor :: constructor) + case('interpolator-M-Z') + allocate(interpolator_js_constructor :: constructor) + case('interpolator-Z') + allocate(interpolator_js_constructor :: constructor) case('reconstructor-JS') allocate(reconstructor_js_constructor :: constructor) case('reconstructor-M-JS') diff --git a/src/lib/factories/wenoof_kappa_factory.f90 b/src/lib/factories/wenoof_kappa_factory.f90 index d7c634d..5f68528 100644 --- a/src/lib/factories/wenoof_kappa_factory.f90 +++ b/src/lib/factories/wenoof_kappa_factory.f90 @@ -5,6 +5,7 @@ module wenoof_kappa_factory use penf, only: I_P use wenoof_kappa_object use wenoof_kappa_rec_js +use wenoof_kappa_int_js implicit none private @@ -27,6 +28,8 @@ subroutine create(constructor, object) select type(constructor) type is(kappa_rec_js_constructor) allocate(kappa_rec_js :: object) + type is(kappa_int_js_constructor) + allocate(kappa_int_js :: object) class default error stop 'error: WenOOF object factory do NOT know the constructor given' endselect @@ -41,8 +44,13 @@ subroutine create_constructor(interpolator_type, S, constructor) select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - ! @TODO implement this - error stop 'interpolator-JS to be implemented' + allocate(kappa_int_js_constructor :: constructor) + case('interpolator-M-JS') + allocate(kappa_int_js_constructor :: constructor) + case('interpolator-M-Z') + allocate(kappa_int_js_constructor :: constructor) + case('interpolator-Z') + allocate(kappa_int_js_constructor :: constructor) case('reconstructor-JS') allocate(kappa_rec_js_constructor :: constructor) case('reconstructor-M-JS') From 6d6fbc9583605cccb0e4075de0f517109021fb10 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 8 Feb 2017 15:08:36 +0100 Subject: [PATCH 05/90] Renamed alpha concrete objects Short description Why: Alpha concrete objects are the same for recontruction and interpolation. This change addresses the need by: * Side effects: * --- ...f_alpha_rec_js.F90 => wenoof_alpha_js.F90} | 0 ...oof_alpha_rec_m.F90 => wenoof_alpha_m.F90} | 20 ++++++++++--------- ...oof_alpha_rec_z.F90 => wenoof_alpha_z.F90} | 0 src/third_party/FOODIE | 1 + 4 files changed, 12 insertions(+), 9 deletions(-) rename src/lib/concrete_objects/{wenoof_alpha_rec_js.F90 => wenoof_alpha_js.F90} (100%) rename src/lib/concrete_objects/{wenoof_alpha_rec_m.F90 => wenoof_alpha_m.F90} (85%) rename src/lib/concrete_objects/{wenoof_alpha_rec_z.F90 => wenoof_alpha_z.F90} (100%) create mode 160000 src/third_party/FOODIE diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 b/src/lib/concrete_objects/wenoof_alpha_js.F90 similarity index 100% rename from src/lib/concrete_objects/wenoof_alpha_rec_js.F90 rename to src/lib/concrete_objects/wenoof_alpha_js.F90 diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 b/src/lib/concrete_objects/wenoof_alpha_m.F90 similarity index 85% rename from src/lib/concrete_objects/wenoof_alpha_rec_m.F90 rename to src/lib/concrete_objects/wenoof_alpha_m.F90 index 2b7d02f..289a9a1 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_m.F90 @@ -77,20 +77,22 @@ subroutine create(self, constructor) pure subroutine compute(self, beta, kappa) !< Compute alpha. - class(alpha_rec_m), intent(inout) :: self !< Alpha. - class(beta_object), intent(in) :: beta !< Beta. - class(kappa_object), intent(in) :: kappa !< Kappa. - integer(I_P) :: f, s1 !< Counters. + class(alpha_rec_m), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + real(RPP) :: kappa_base !< Kappa evaluated from the base alphas. + integer(I_P) :: f, s1 !< Counters. self%values_sum = 0._RPP call self%alpha_base%compute(beta=beta, kappa=kappa) do s1=0, self%S - 1 ! stencil loops do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = & - (self%alpha_base%values(f, s1) * (kappa%values(f, s1) + kappa%values(f, s1) * kappa%values(f, s1) - & - 3._RPP * kappa%values(f, s1) * self%alpha_base%values(f, s1) + self%alpha_base%values(f, s1) * & - self%alpha_base%values(f, s1))) / & - (kappa%values(f, s1) * kappa%values(f, s1) + self%alpha_base%values(f, s1) * & + kappa_base = self%alpha_base%values(f, s1) / self%alpha_base%values_sum(f) + self%values(f, s1) = & + (kappa_base * (kappa%values(f, s1) + kappa%values(f, s1) * kappa%values(f, s1) - & + 3._RPP * kappa%values(f, s1) * kappa_base + kappa_base * & + kappa_base)) / & + (kappa%values(f, s1) * kappa%values(f, s1) + kappa_base * & (1._RPP - 2._RPP * kappa%values(f, s1))) self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 b/src/lib/concrete_objects/wenoof_alpha_z.F90 similarity index 100% rename from src/lib/concrete_objects/wenoof_alpha_rec_z.F90 rename to src/lib/concrete_objects/wenoof_alpha_z.F90 diff --git a/src/third_party/FOODIE b/src/third_party/FOODIE new file mode 160000 index 0000000..10113d3 --- /dev/null +++ b/src/third_party/FOODIE @@ -0,0 +1 @@ +Subproject commit 10113d3a009609f3529f11dab96d364d6e3c9e7b From 587e2967f54e410f4829c31c4d04309916d6a62e Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 9 Feb 2017 09:12:15 +0100 Subject: [PATCH 06/90] Add interpolation allocations Short description Why: * This change addresses the need by: * Side effects: * --- src/lib/factories/wenoof_interpolator_factory.f90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/lib/factories/wenoof_interpolator_factory.f90 b/src/lib/factories/wenoof_interpolator_factory.f90 index 0b984d4..1979d84 100644 --- a/src/lib/factories/wenoof_interpolator_factory.f90 +++ b/src/lib/factories/wenoof_interpolator_factory.f90 @@ -69,6 +69,9 @@ subroutine create_constructor(interpolator_type, S, interpolations_constructor, endselect call constructor%create(S=S, face_left=face_left, face_right=face_right) select type(constructor) + type is(interpolator_js_constructor) + allocate(constructor%interpolations_constructor, source=interpolations_constructor) + allocate(constructor%weights_constructor, source=weights_constructor) type is(reconstructor_js_constructor) allocate(constructor%interpolations_constructor, source=interpolations_constructor) allocate(constructor%weights_constructor, source=weights_constructor) From 9b4441f7071619ff4c1e3bb671e8eaca1e82e4d7 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 9 Feb 2017 10:28:01 +0100 Subject: [PATCH 07/90] Fix line width Short description Why: * This change addresses the need by: * Side effects: * --- .../concrete_objects/wenoof_beta_int_js.F90 | 348 +++++++++--------- 1 file changed, 174 insertions(+), 174 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_beta_int_js.F90 b/src/lib/concrete_objects/wenoof_beta_int_js.F90 index 11374e1..2df8d75 100644 --- a/src/lib/concrete_objects/wenoof_beta_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_int_js.F90 @@ -263,185 +263,185 @@ subroutine create(self, constructor) c(3,4,4) = 0._RPP ; c(4,4,4) = 668977._RPP / 30240._RPP case(6) ! 11th order ! stencil 0 - ! i*i ; (i-1)*i ; (i-2)*i - c(0,0,0) = 373189088._RPP / 7027375._RPP; c(1,0,0) = -157371280._RPP / 384113._RPP; c(2,0,0) = 497902688._RPP / 756325._RPP - ! (i-3)*i ; (i-4)*i ; (i-5)*i - c(3,0,0) = -427867945._RPP / 780329._RPP; c(4,0,0) = 295095211._RPP / 1259192._RPP; c(5,0,0) = -131759526._RPP / 3224383._RPP - - ! / ; (i-1)*(i-1) ; (i-2)*(i-1) - c(0,1,0) = 0._RPP ; c(1,1,0) = 498196769._RPP / 609968._RPP; c(2,1,0) = -497421494._RPP / 185427._RPP - ! (i-3)*(i-1) ; (i-4)*(i-1) ; (i-5)*(i-1) - c(3,1,0) = 1150428332._RPP / 508385._RPP; c(4,1,0) = -674462631._RPP / 691651._RPP; c(5,1,0) = 112453613._RPP / 657635._RPP - - ! / ; / ; (i-2)*(i-2) - c(0,2,0) = 0._RPP ; c(1,2,0) = 0._RPP ; c(2,2,0) = 2292397033._RPP / 1024803._RPP - ! (i-3)*(i-2) ; (i-4)*(i-2) ; (i-5)*(i-2) - c(3,2,0) = -378281867._RPP / 99229._RPP; c(4,2,0) = 1328498639._RPP / 803154._RPP; c(5,2,0) = -115324682._RPP / 395671._RPP - - ! / ; / ; / - c(0,3,0) = 0._RPP ; c(1,3,0) = 0._RPP ; c(2,3,0) = 0._RPP - ! (i-3)*(i-3) ; (i-4)*(i-3) ; (i-5)*(i-3) - c(3,3,0) = 1406067637._RPP / 859229._RPP; c(4,3,0) =-2146148426._RPP / 1503065._RPP; c(5,3,0) = 586668707._RPP / 2322432._RPP - - ! / ; / ; / - c(0,4,0) = 0._RPP ; c(1,4,0) = 0._RPP ; c(2,4,0) = 0._RPP - ! / ; (i-4)*(i-4) ; (i-5)*(i-4) - c(3,4,0) = 0._RPP ; c(4,4,0) = 453375035._RPP / 1449454._RPP; c(5,4,0) = -504893127._RPP / 4547012._RPP - - ! / ; / ; / - c(0,5,0) = 0._RPP ; c(1,5,0) = 0._RPP ; c(2,5,0) = 0._RPP - ! / ; / ; (i-5)*(i-5) - c(3,5,0) = 0._RPP ; c(4,5,0) = 0._RPP ; c(5,5,0) = 105552913._RPP / 10682745._RPP + ! i*i ; (i-1)*i ; (i-2)*i + c(0,0,0) = 373189088._RPP/ 7027375._RPP; c(1,0,0) = -157371280._RPP/ 384113._RPP; c(2,0,0) = 497902688._RPP/ 756325._RPP + ! (i-3)*i ; (i-4)*i ; (i-5)*i + c(3,0,0) =-427867945._RPP/ 780329._RPP; c(4,0,0) = 295095211._RPP/ 1259192._RPP; c(5,0,0) = -131759526._RPP/ 3224383._RPP + + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(0,1,0) = 0._RPP ; c(1,1,0) = 498196769._RPP/ 609968._RPP; c(2,1,0) = -497421494._RPP/ 185427._RPP + ! (i-3)*(i-1) ; (i-4)*(i-1) ; (i-5)*(i-1) + c(3,1,0) =1150428332._RPP/ 508385._RPP; c(4,1,0) = -674462631._RPP/ 691651._RPP; c(5,1,0) = 112453613._RPP/ 657635._RPP + + ! / ; / ; (i-2)*(i-2) + c(0,2,0) = 0._RPP ; c(1,2,0) = 0._RPP ; c(2,2,0) = 2292397033._RPP/ 1024803._RPP + ! (i-3)*(i-2) ; (i-4)*(i-2) ; (i-5)*(i-2) + c(3,2,0) =-378281867._RPP/ 99229._RPP; c(4,2,0) = 1328498639._RPP/ 803154._RPP; c(5,2,0) = -115324682._RPP/ 395671._RPP + + ! / ; / ; / + c(0,3,0) = 0._RPP ; c(1,3,0) = 0._RPP ; c(2,3,0) = 0._RPP + ! (i-3)*(i-3) ; (i-4)*(i-3) ; (i-5)*(i-3) + c(3,3,0) =1406067637._RPP/ 859229._RPP; c(4,3,0) =-2146148426._RPP/ 1503065._RPP; c(5,3,0) = 586668707._RPP/ 2322432._RPP + + ! / ; / ; / + c(0,4,0) = 0._RPP ; c(1,4,0) = 0._RPP ; c(2,4,0) = 0._RPP + ! / ; (i-4)*(i-4) ; (i-5)*(i-4) + c(3,4,0) = 0._RPP ; c(4,4,0) = 453375035._RPP/ 1449454._RPP; c(5,4,0) = -504893127._RPP/ 4547012._RPP + + ! / ; / ; / + c(0,5,0) = 0._RPP ; c(1,5,0) = 0._RPP ; c(2,5,0) = 0._RPP + ! / ; / ; (i-5)*(i-5) + c(3,5,0) = 0._RPP ; c(4,5,0) = 0._RPP ; c(5,5,0) = 105552913._RPP/10682745._RPP ! stencil 1 - ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) - c(0,0,1) = 105552913._RPP / 10682745._RPP; c(1,0,1) = -338120165._RPP / 4351341._RPP; c(2,0,1) = 356490569._RPP / 2842289._RPP - ! (i-2)*(i+1) ; (i-3)*(i+1) ; (i-4)*(i+1) - c(3,0,1) =-146902225._RPP / 1415767._RPP; c(4,0,1) = 195395281._RPP / 4459947._RPP; c(5,0,1) = -24044484._RPP / 3193217._RPP - - ! / ; i*i ; (i-1)*i - c(0,1,1) = 0._RPP ; c(1,1,1) = 169505788._RPP / 1035915._RPP; c(2,1,1) =-2984991531._RPP / 5434265._RPP - ! (i-2)*i ; (i-3)*i ; (i-4)*i - c(3,1,1) = 771393469._RPP / 1663855._RPP; c(4,1,1) = -270758311._RPP / 1365867._RPP; c(5,1,1) = 26449004._RPP / 769961._RPP - - ! / ; / ; (i-1)*(i-1) - c(0,2,1) = 0._RPP ; c(1,2,1) = 0._RPP ; c(2,2,1) = 471933572._RPP / 993629._RPP - ! (i-2)*(i-1) ; (i-3)*(i-1) ; (i-4)*(i-1) - c(3,2,1) =-479783044._RPP / 585775._RPP; c(4,2,1) = 840802608._RPP / 2367661._RPP; c(5,2,1) = -347085621._RPP / 5587817._RPP - - ! / ; / ; / - c(0,3,1) = 0._RPP ; c(1,3,1) = 0._RPP ; c(2,3,1) = 0._RPP - ! (i-2)*(i-2) ; (i-3)*(i-2) ; (i-4)*(i-2) - c(3,3,1) =1031953342._RPP / 2867575._RPP; c(4,3,1) = -288641753._RPP / 912148._RPP; c(5,3,1) = 315600562._RPP / 5645537._RPP - - ! / ; / ; / - c(0,4,1) = 0._RPP ; c(1,4,1) = 0._RPP ; c(2,4,1) = 0._RPP - ! / ; (i-3)*(i-3) ; (i-4)*(i-3) - c(3,4,1) = 0._RPP ; c(4,4,1) = 142936745._RPP / 2029182._RPP; c(5,4,1) = -109600459._RPP / 4359925._RPP - - ! / ; / ; / - c(0,5,1) = 0._RPP ; c(1,5,1) = 0._RPP ; c(2,5,1) = 0._RPP - ! / ; / ; (i-4)*(i-4) - c(3,5,1) = 0._RPP ; c(4,5,1) = 0._RPP ; c(5,5,1) = 30913579._RPP / 13651507._RPP + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(0,0,1) = 105552913._RPP/10682745._RPP; c(1,0,1) = -338120165._RPP/ 4351341._RPP; c(2,0,1) = 356490569._RPP/ 2842289._RPP + ! (i-2)*(i+1) ; (i-3)*(i+1) ; (i-4)*(i+1) + c(3,0,1) =-146902225._RPP/ 1415767._RPP; c(4,0,1) = 195395281._RPP/ 4459947._RPP; c(5,0,1) = -24044484._RPP/ 3193217._RPP + + ! / ; i*i ; (i-1)*i + c(0,1,1) = 0._RPP ; c(1,1,1) = 169505788._RPP/ 1035915._RPP; c(2,1,1) =-2984991531._RPP/ 5434265._RPP + ! (i-2)*i ; (i-3)*i ; (i-4)*i + c(3,1,1) = 771393469._RPP/ 1663855._RPP; c(4,1,1) = -270758311._RPP/ 1365867._RPP; c(5,1,1) = 26449004._RPP/ 769961._RPP + + ! / ; / ; (i-1)*(i-1) + c(0,2,1) = 0._RPP ; c(1,2,1) = 0._RPP ; c(2,2,1) = 471933572._RPP/ 993629._RPP + ! (i-2)*(i-1) ; (i-3)*(i-1) ; (i-4)*(i-1) + c(3,2,1) =-479783044._RPP/ 585775._RPP; c(4,2,1) = 840802608._RPP/ 2367661._RPP; c(5,2,1) = -347085621._RPP/ 5587817._RPP + + ! / ; / ; / + c(0,3,1) = 0._RPP ; c(1,3,1) = 0._RPP ; c(2,3,1) = 0._RPP + ! (i-2)*(i-2) ; (i-3)*(i-2) ; (i-4)*(i-2) + c(3,3,1) =1031953342._RPP/ 2867575._RPP; c(4,3,1) = -288641753._RPP/ 912148._RPP; c(5,3,1) = 315600562._RPP/ 5645537._RPP + + ! / ; / ; / + c(0,4,1) = 0._RPP ; c(1,4,1) = 0._RPP ; c(2,4,1) = 0._RPP + ! / ; (i-3)*(i-3) ; (i-4)*(i-3) + c(3,4,1) = 0._RPP ; c(4,4,1) = 142936745._RPP/ 2029182._RPP; c(5,4,1) = -109600459._RPP/ 4359925._RPP + + ! / ; / ; / + c(0,5,1) = 0._RPP ; c(1,5,1) = 0._RPP ; c(2,5,1) = 0._RPP + ! / ; / ; (i-4)*(i-4) + c(3,5,1) = 0._RPP ; c(4,5,1) = 0._RPP ; c(5,5,1) = 30913579._RPP/13651507._RPP ! stencil 2 - ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) - c(0,0,2) = 30913579._RPP / 13651507._RPP; c(1,0,2) = -87214523._RPP / 4439774._RPP; c(2,0,2) = 99590409._RPP / 2965471._RPP - ! (i-1)*(i+2) ; (i-2)*(i+2) ; (i-3)*(i+2) - c(3,0,2) = -95644735._RPP / 3360137._RPP; c(4,0,2) = 79135747._RPP / 6577234._RPP; c(5,0,2) = -28962993._RPP / 14228092._RPP - - ! / ; (i+1)*(i+1) ; i*(i+1) - c(0,1,2) = 0._RPP ; c(1,1,2) = 24025059._RPP / 519766._RPP; c(2,1,2) = -370146220._RPP / 2226351._RPP - ! (i-1)*(i+1) ; (i-2)*(i+1) ; (i-3)*(i+1) - c(3,1,2) = 87743770._RPP / 602579._RPP; c(4,1,2) = -1512485867._RPP / 24006092._RPP; c(5,1,2) = 251883319._RPP / 23224320._RPP - - ! / ; / ; i*i - c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 200449727._RPP / 1269707_RPP - ! (i-1)*i ; (i-2)*i ; (i-3)*i - c(3,2,2) = -274966489._RPP / 950662._RPP; c(4,2,2) = 201365679._RPP / 1563055._RPP; c(5,2,2) = -61673356._RPP / 2721737._RPP - - ! / ; / ; / - c(0,3,2) = 0._RPP ; c(1,3,2) = 0._RPP ; c(2,3,2) = 0._RPP - ! (i-1)*(i-1) ; (i-2)*(i-1) ; (i-3)*(i-1) - c(3,3,2) = 586743463._RPP / 4237706._RPP; c(4,3,2) = -723607356._RPP / 5654437._RPP; c(5,3,2) = 268747951._RPP / 11612160._RPP - - ! / ; / ; / - c(0,4,2) = 0._RPP ; c(1,4,2) = 0._RPP ; c(2,4,2) = 0._RPP - ! / ; (i-2)*(i-2) ; (i-3)*(i-2) - c(3,4,2) = 0._RPP ; c(4,4,2) = 113243845._RPP / 3672222._RPP; c(5,4,2) = -74146214._RPP / 6413969._RPP - - ! / ; / ; / - c(0,5,2) = 0._RPP ; c(1,5,2) = 0._RPP ; c(2,5,2) = 0._RPP - ! / ; / ; (i-3)*(i-3) - c(3,5,2) = 0._RPP ; c(4,5,2) = 0._RPP ; c(5,5,2) = 15418339._RPP / 13608685._RPP + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(0,0,2) = 30913579._RPP/13651507._RPP; c(1,0,2) = -87214523._RPP/ 4439774._RPP; c(2,0,2) = 99590409._RPP/ 2965471._RPP + ! (i-1)*(i+2) ; (i-2)*(i+2) ; (i-3)*(i+2) + c(3,0,2) = -95644735._RPP/ 3360137._RPP; c(4,0,2) = 79135747._RPP/ 6577234._RPP; c(5,0,2) = -28962993._RPP/14228092._RPP + + ! / ; (i+1)*(i+1) ; i*(i+1) + c(0,1,2) = 0._RPP ; c(1,1,2) = 24025059._RPP/ 519766._RPP; c(2,1,2) = -370146220._RPP/ 2226351._RPP + ! (i-1)*(i+1) ; (i-2)*(i+1) ; (i-3)*(i+1) + c(3,1,2) = 87743770._RPP/ 602579._RPP; c(4,1,2) =-1512485867._RPP/24006092._RPP; c(5,1,2) = 251883319._RPP/23224320._RPP + + ! / ; / ; i*i + c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 200449727._RPP/ 1269707_RPP + ! (i-1)*i ; (i-2)*i ; (i-3)*i + c(3,2,2) =-274966489._RPP/ 950662._RPP; c(4,2,2) = 201365679._RPP/ 1563055._RPP; c(5,2,2) = -61673356._RPP/ 2721737._RPP + + ! / ; / ; / + c(0,3,2) = 0._RPP ; c(1,3,2) = 0._RPP ; c(2,3,2) = 0._RPP + ! (i-1)*(i-1) ; (i-2)*(i-1) ; (i-3)*(i-1) + c(3,3,2) = 586743463._RPP/ 4237706._RPP; c(4,3,2) = -723607356._RPP/ 5654437._RPP; c(5,3,2) = 268747951._RPP/11612160._RPP + + ! / ; / ; / + c(0,4,2) = 0._RPP ; c(1,4,2) = 0._RPP ; c(2,4,2) = 0._RPP + ! / ; (i-2)*(i-2) ; (i-3)*(i-2) + c(3,4,2) = 0._RPP ; c(4,4,2) = 113243845._RPP/ 3672222._RPP; c(5,4,2) = -74146214._RPP/ 6413969._RPP + + ! / ; / ; / + c(0,5,2) = 0._RPP ; c(1,5,2) = 0._RPP ; c(2,5,2) = 0._RPP + ! / ; / ; (i-3)*(i-3) + c(3,5,2) = 0._RPP ; c(4,5,2) = 0._RPP ; c(5,5,2) = 15418339._RPP/13608685._RPP ! stencil 3 - ! (i+3)*(i+3) ; (i+2)*(i+3) ; (i+1)*(i+3) - c(0,0,3) = 15418339._RPP / 13608685._RPP; c(1,0,3) = -74146214._RPP / 6413969._RPP; c(2,0,3) = 268747951._RPP / 11612160._RPP - ! i*(i+3) ; (i-1)*(i+3) ; (i-2)*(i+3) - c(3,0,3) = -61673356._RPP / 2721737._RPP; c(4,0,3) = 251883319._RPP / 23224320._RPP; c(5,0,3) = -28962993._RPP / 14228092._RPP - - ! / ; (i+2)*(i+2) ; (i+1)*(i+2) - c(0,1,3) = 0._RPP ; c(1,1,3) = 113243845._RPP / 3672222._RPP; c(2,1,3) = -723607356._RPP / 5654437._RPP - ! i*(i+2) ; (i-1)*(i+2) ; (i-2)*(i+2) - c(3,1,3) = 201365679._RPP / 1563055._RPP; c(4,1,3) = -1512485867._RPP / 24006092._RPP; c(5,1,3) = 79135747._RPP / 6577234._RPP - - ! / ; / ; (i+1)*(i+1) - c(0,2,3) = 0._RPP ; c(1,2,3) = 0._RPP ; c(2,2,3) = 586743463._RPP / 4237706._RPP - ! i*(i+1) ; (i-1)*(i+1) ; (i-2)*(i+1) - c(3,2,3) = -274966489._RPP / 950662._RPP; c(4,2,3) = 87743770._RPP / 602579._RPP; c(5,2,3) = -95644735._RPP / 3360137._RPP - - ! / ; / ; / - c(0,3,3) = 0._RPP ; c(1,3,3) = 0._RPP ; c(2,3,3) = 0._RPP - ! i*i ; (i-1)*i ; (i-2)*i - c(3,3,3) = 200449727._RPP / 1269707._RPP; c(4,3,3) = -370146220._RPP / 2226351._RPP; c(5,3,3) = 99590409._RPP / 2965471._RPP - - ! / ; / ; / - c(0,4,3) = 0._RPP ; c(1,4,3) = 0._RPP ; c(2,4,3) = 0._RPP - ! / ; (i-1)*(i-1) ; (i-2)*(i-1) - c(3,4,3) = 0._RPP ; c(4,4,3) = 24025059._RPP / 519766._RPP; c(5,4,3) = -87214523._RPP / 4439774._RPP - - ! / ; / ; / - c(0,5,3) = 0._RPP ; c(1,5,3) = 0._RPP ; c(2,5,3) = 0._RPP - ! / ; / ; (i-2)*(i-2) - c(3,5,3) = 0._RPP ; c(4,5,3) = 0._RPP ; c(5,5,3) = 30913579._RPP / 13651507._RPP + ! (i+3)*(i+3) ; (i+2)*(i+3) ; (i+1)*(i+3) + c(0,0,3) = 15418339._RPP/13608685._RPP; c(1,0,3) = -74146214._RPP/ 6413969._RPP; c(2,0,3) = 268747951._RPP/11612160._RPP + ! i*(i+3) ; (i-1)*(i+3) ; (i-2)*(i+3) + c(3,0,3) = -61673356._RPP/ 2721737._RPP; c(4,0,3) = 251883319._RPP/23224320._RPP; c(5,0,3) = -28962993._RPP/14228092._RPP + + ! / ; (i+2)*(i+2) ; (i+1)*(i+2) + c(0,1,3) = 0._RPP ; c(1,1,3) = 113243845._RPP/ 3672222._RPP; c(2,1,3) = -723607356._RPP/ 5654437._RPP + ! i*(i+2) ; (i-1)*(i+2) ; (i-2)*(i+2) + c(3,1,3) = 201365679._RPP/ 1563055._RPP; c(4,1,3) =-1512485867._RPP/24006092._RPP; c(5,1,3) = 79135747._RPP/ 6577234._RPP + + ! / ; / ; (i+1)*(i+1) + c(0,2,3) = 0._RPP ; c(1,2,3) = 0._RPP ; c(2,2,3) = 586743463._RPP/ 4237706._RPP + ! i*(i+1) ; (i-1)*(i+1) ; (i-2)*(i+1) + c(3,2,3) =-274966489._RPP/ 950662._RPP; c(4,2,3) = 87743770._RPP/ 602579._RPP; c(5,2,3) = -95644735._RPP/ 3360137._RPP + + ! / ; / ; / + c(0,3,3) = 0._RPP ; c(1,3,3) = 0._RPP ; c(2,3,3) = 0._RPP + ! i*i ; (i-1)*i ; (i-2)*i + c(3,3,3) = 200449727._RPP/ 1269707._RPP; c(4,3,3) = -370146220._RPP/ 2226351._RPP; c(5,3,3) = 99590409._RPP/ 2965471._RPP + + ! / ; / ; / + c(0,4,3) = 0._RPP ; c(1,4,3) = 0._RPP ; c(2,4,3) = 0._RPP + ! / ; (i-1)*(i-1) ; (i-2)*(i-1) + c(3,4,3) = 0._RPP ; c(4,4,3) = 24025059._RPP/ 519766._RPP; c(5,4,3) = -87214523._RPP/ 4439774._RPP + + ! / ; / ; / + c(0,5,3) = 0._RPP ; c(1,5,3) = 0._RPP ; c(2,5,3) = 0._RPP + ! / ; / ; (i-2)*(i-2) + c(3,5,3) = 0._RPP ; c(4,5,3) = 0._RPP ; c(5,5,3) = 30913579._RPP/13651507._RPP ! stencil 4 - ! (i+4)*(i+4) ; (i+3)*(i+4) ; (i+2)*(i+4) - c(0,0,4) = 30913579._RPP / 13651507._RPP; c(1,0,4) = -109600459._RPP / 4359925._RPP; c(2,0,4) = 315600562._RPP / 5645537._RPP - ! (i+1)*(i+4) ; i*(i+4) ; (i-1)*(i+4) - c(3,0,4) = -347085621._RPP / 5587817._RPP; c(4,0,4) = 26449004._RPP / 769961._RPP; c(5,0,4) = -24044484._RPP / 3193217._RPP - - ! / ; (i+3)*(i+3) ; (i+2)*(i+3) - c(0,1,4) = 0._RPP ; c(1,1,4) = 142936745._RPP / 2029182._RPP; c(2,1,4) = -288641753._RPP / 912148._RPP - ! (i+1)*(i+3) ; i*(i+3) ; (i-1)*(i+3) - c(3,1,4) = 840802608._RPP / 2367661._RPP; c(4,1,4) = -270758311._RPP / 1365867._RPP; c(5,1,4) = 195395281._RPP / 4459947._RPP - - ! / ; / ; (i+2)*(i+2) - c(0,2,4) = 0._RPP ; c(1,2,4) = 0._RPP ; c(2,2,4) = 1031953342._RPP / 2867575._RPP - ! (i+1)*(i+2) ; i*(i+2) ; (i-1)*(i+2) - c(3,2,4) = -479783044._RPP / 585775._RPP; c(4,2,4) = 771393469._RPP / 1663855._RPP; c(5,2,4) = -146902225._RPP / 1415767._RPP - - ! / ; / ; / - c(0,3,4) = 0._RPP ; c(1,3,4) = 0._RPP ; c(2,3,4) = 0._RPP - ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) - c(3,3,4) = 471933572._RPP / 993629._RPP; c(4,3,4) = -2984991531._RPP / 5434265._RPP; c(5,3,4) = 356490569._RPP / 2842289._RPP - - ! / ; / ; / - c(0,4,4) = 0._RPP ; c(1,4,4) = 0._RPP ; c(2,4,4) = 0._RPP - ! / ; i*i ; (i-1)*i - c(3,4,4) = 0._RPP ; c(4,4,4) = 169505788._RPP / 1035915._RPP; c(5,4,4) = -338120165._RPP / 4351341._RPP - - ! / ; / ; / - c(0,5,4) = 0._RPP ; c(1,5,4) = 0._RPP ; c(2,5,4) = 0._RPP - ! / ; / ; (i-1)*(i-1) - c(3,5,4) = 0._RPP ; c(4,5,4) = 0._RPP ; c(5,5,4) = 105552913._RPP / 10682745._RPP + ! (i+4)*(i+4) ; (i+3)*(i+4) ; (i+2)*(i+4) + c(0,0,4) = 30913579._RPP/13651507._RPP; c(1,0,4) = -109600459._RPP/ 4359925._RPP; c(2,0,4) = 315600562._RPP/ 5645537._RPP + ! (i+1)*(i+4) ; i*(i+4) ; (i-1)*(i+4) + c(3,0,4) =-347085621._RPP/ 5587817._RPP; c(4,0,4) = 26449004._RPP/ 769961._RPP; c(5,0,4) = -24044484._RPP/ 3193217._RPP + + ! / ; (i+3)*(i+3) ; (i+2)*(i+3) + c(0,1,4) = 0._RPP ; c(1,1,4) = 142936745._RPP/ 2029182._RPP; c(2,1,4) = -288641753._RPP/ 912148._RPP + ! (i+1)*(i+3) ; i*(i+3) ; (i-1)*(i+3) + c(3,1,4) = 840802608._RPP/ 2367661._RPP; c(4,1,4) = -270758311._RPP/ 1365867._RPP; c(5,1,4) = 195395281._RPP/ 4459947._RPP + + ! / ; / ; (i+2)*(i+2) + c(0,2,4) = 0._RPP ; c(1,2,4) = 0._RPP ; c(2,2,4) = 1031953342._RPP/ 2867575._RPP + ! (i+1)*(i+2) ; i*(i+2) ; (i-1)*(i+2) + c(3,2,4) =-479783044._RPP/ 585775._RPP; c(4,2,4) = 771393469._RPP/ 1663855._RPP; c(5,2,4) = -146902225._RPP/ 1415767._RPP + + ! / ; / ; / + c(0,3,4) = 0._RPP ; c(1,3,4) = 0._RPP ; c(2,3,4) = 0._RPP + ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) + c(3,3,4) = 471933572._RPP/ 993629._RPP; c(4,3,4) =-2984991531._RPP/ 5434265._RPP; c(5,3,4) = 356490569._RPP/ 2842289._RPP + + ! / ; / ; / + c(0,4,4) = 0._RPP ; c(1,4,4) = 0._RPP ; c(2,4,4) = 0._RPP + ! / ; i*i ; (i-1)*i + c(3,4,4) = 0._RPP ; c(4,4,4) = 169505788._RPP/ 1035915._RPP; c(5,4,4) = -338120165._RPP/ 4351341._RPP + + ! / ; / ; / + c(0,5,4) = 0._RPP ; c(1,5,4) = 0._RPP ; c(2,5,4) = 0._RPP + ! / ; / ; (i-1)*(i-1) + c(3,5,4) = 0._RPP ; c(4,5,4) = 0._RPP ; c(5,5,4) = 105552913._RPP/10682745._RPP ! stencil 5 - ! (i+5)*(i+5) ; (i+4)*(i+5) ; (i+3)*(i+5) - c(0,0,5) = 105552913._RPP / 10682745._RPP; c(1,0,5) = -504893127._RPP / 4547012._RPP; c(2,0,5) = 586668707._RPP / 2322432._RPP - ! (i+2)*(i+5) ; (i+1)*(i+5) ; i*(i+5) - c(3,0,5) = -115324682._RPP / 395671._RPP; c(4,0,5) = 112453613._RPP / 657635._RPP; c(5,0,5) = -131759526._RPP / 3224383._RPP - - ! / ; (i+4)*(i+3) ; (i+3)*(i+3) - c(0,1,5) = 0._RPP ; c(1,1,5) = 453375035._RPP / 1449454._RPP; c(2,1,5) = -2146148426._RPP / 1503065._RPP - ! (i+2)*(i+3) ; (i+1)*(i+3) ; i*(i+3) - c(3,1,5) = 1328498639._RPP / 803154._RPP; c(4,1,5) = -674462631._RPP / 691651._RPP; c(5,1,5) = 295095211._RPP / 1259192._RPP - - ! / ; / ; (i+3)*(i+2) - c(0,2,5) = 0._RPP ; c(1,2,5) = 0._RPP ; c(2,2,5) = 1406067637._RPP / 859229._RPP - ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) - c(3,2,5) = -378281867._RPP / 99229._RPP; c(4,2,5) = 1150428332._RPP / 508385._RPP; c(5,2,5) = -427867945._RPP / 780329._RPP - - ! / ; / ; / - c(0,3,5) = 0._RPP ; c(1,3,5) = 0._RPP ; c(2,3,5) = 0._RPP - ! (i+2)*(i+1) ; (i+1)*(i+1) ; i*(i+1) - c(3,3,5) = 2292397033._RPP / 1024803._RPP; c(4,3,5) = -497421494._RPP / 185427._RPP; c(5,3,5) = 497902668._RPP / 756325._RPP - - ! / ; / ; / - c(0,4,5) = 0._RPP ; c(1,4,5) = 0._RPP ; c(2,4,5) = 0._RPP - ! / ; (i+1)*i ; i*i - c(3,4,5) = 0._RPP ; c(4,4,5) = 498196769._RPP / 609968._RPP; c(5,4,5) = -157371280._RPP / 384113._RPP - - ! / ; / ; / - c(0,5,5) = 0._RPP ; c(1,5,5) = 0._RPP ; c(2,5,5) = 0._RPP - ! / ; / ; i*(i-1) - c(3,5,5) = 0._RPP ; c(4,5,5) = 0._RPP ; c(5,5,5) = 373189088._RPP / 7027375._RPP + ! (i+5)*(i+5) ; (i+4)*(i+5) ; (i+3)*(i+5) + c(0,0,5) = 105552913._RPP/10682745._RPP; c(1,0,5) = -504893127._RPP/ 4547012._RPP; c(2,0,5) = 586668707._RPP/ 2322432._RPP + ! (i+2)*(i+5) ; (i+1)*(i+5) ; i*(i+5) + c(3,0,5) =-115324682._RPP/ 395671._RPP; c(4,0,5) = 112453613._RPP/ 657635._RPP; c(5,0,5) = -131759526._RPP/ 3224383._RPP + + ! / ; (i+4)*(i+3) ; (i+3)*(i+3) + c(0,1,5) = 0._RPP ; c(1,1,5) = 453375035._RPP/ 1449454._RPP; c(2,1,5) =-2146148426._RPP/ 1503065._RPP + ! (i+2)*(i+3) ; (i+1)*(i+3) ; i*(i+3) + c(3,1,5) =1328498639._RPP/ 803154._RPP; c(4,1,5) = -674462631._RPP/ 691651._RPP; c(5,1,5) = 295095211._RPP/ 1259192._RPP + + ! / ; / ; (i+3)*(i+2) + c(0,2,5) = 0._RPP ; c(1,2,5) = 0._RPP ; c(2,2,5) = 1406067637._RPP/ 859229._RPP + ! (i+2)*(i+2) ; (i+1)*(i+2) ; i*(i+2) + c(3,2,5) =-378281867._RPP/ 99229._RPP; c(4,2,5) = 1150428332._RPP/ 508385._RPP; c(5,2,5) = -427867945._RPP/ 780329._RPP + + ! / ; / ; / + c(0,3,5) = 0._RPP ; c(1,3,5) = 0._RPP ; c(2,3,5) = 0._RPP + ! (i+2)*(i+1) ; (i+1)*(i+1) ; i*(i+1) + c(3,3,5) =2292397033._RPP/ 1024803._RPP; c(4,3,5) = -497421494._RPP/ 185427._RPP; c(5,3,5) = 497902668._RPP/ 756325._RPP + + ! / ; / ; / + c(0,4,5) = 0._RPP ; c(1,4,5) = 0._RPP ; c(2,4,5) = 0._RPP + ! / ; (i+1)*i ; i*i + c(3,4,5) = 0._RPP ; c(4,4,5) = 498196769._RPP/ 609968._RPP; c(5,4,5) = -157371280._RPP/ 384113._RPP + + ! / ; / ; / + c(0,5,5) = 0._RPP ; c(1,5,5) = 0._RPP ; c(2,5,5) = 0._RPP + ! / ; / ; i*(i-1) + c(3,5,5) = 0._RPP ; c(4,5,5) = 0._RPP ; c(5,5,5) = 373189088._RPP/ 7027375._RPP case(7) ! 13th order ! stencil 0 ! i*i ; (i-1)*i From a55e9a48009709b7d454ac22993aebd3dc9549e5 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 9 Feb 2017 10:33:36 +0100 Subject: [PATCH 08/90] Fix minor issues Short description Why: * This change addresses the need by: * Side effects: * --- fobos | 2 +- src/lib/concrete_objects/wenoof_interpolations_int_js.F90 | 2 +- src/lib/concrete_objects/wenoof_interpolator_js.F90 | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/fobos b/fobos index 85e1f94..c4455ae 100644 --- a/fobos +++ b/fobos @@ -13,7 +13,7 @@ $CSTATIC_INT = -cpp -c -assume realloc_lhs $DEBUG_GNU = -Og -g3 -Warray-bounds -Wcharacter-truncation -Wline-truncation -Wimplicit-interface -Wimplicit-procedure -Wunderflow -fcheck=all -fmodule-private -ffree-line-length-132 -fimplicit-none -fbacktrace -fdump-core -finit-real=nan -std=f2008 -fall-intrinsics $DEBUG_INT = -O0 -debug all -check all -warn all -extend-source 132 -traceback -gen-interfaces#-fpe-all=0 -fp-stack-check -fstack-protector-all -ftrapuv -no-ftz -std08 $OPTIMIZE = -O2 -$EXDIRS = FLAP/src/tests/ FLAP/src/third_party/ PENF/src/tests/ pyplot-fortran/src/tests/ +$EXDIRS = FLAP/src/tests/ FLAP/src/third_party/ PENF/src/tests/ pyplot-fortran/src/tests/ FOODIE/src/tests/ # main modes diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index 89eec70..0f374bf 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -37,7 +37,7 @@ module wenoof_interpolations_int_js procedure, pass(self) :: compute !< Compute interpolations. procedure, pass(self) :: description !< Return interpolations string-description. procedure, pass(self) :: destroy !< Destroy interpolations. -endtype interpolations_rec_js +endtype interpolations_int_js contains ! public deferred methods diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index 88a3cab..487474f 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -4,9 +4,9 @@ module wenoof_interpolator_js use, intrinsic :: iso_fortran_env, only : stderr=>error_unit #ifdef r16p -use penf, only: RPP=>R16P +use penf, only: I_P, RPP=>R16P, str #else -use penf, only: RPP=>R8P +use penf, only: I_P, RPP=>R8P, str #endif use wenoof_base_object use wenoof_interpolations_factory From b4e3fb3e2b347ee053e199c4a942dadeca3cd78a Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 13 Feb 2017 09:28:23 +0100 Subject: [PATCH 09/90] Improved test ui Short description Why: Improved test ui for interpolation tests This change addresses the need by: * Side effects: * --- src/tests/cos_reconstruction.f90 | 333 +++++++++++++++++++++++++++++++ src/tests/wenoof_test_ui.f90 | 128 ++++++++++++ 2 files changed, 461 insertions(+) create mode 100644 src/tests/cos_reconstruction.f90 create mode 100644 src/tests/wenoof_test_ui.f90 diff --git a/src/tests/cos_reconstruction.f90 b/src/tests/cos_reconstruction.f90 new file mode 100644 index 0000000..d4b141b --- /dev/null +++ b/src/tests/cos_reconstruction.f90 @@ -0,0 +1,333 @@ +!< WenOOF test: reconstruction of cosine function. +module cos_test_module +!< Auxiliary module defining the test class. + +use flap, only : command_line_interface +#ifdef r16p +use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz +#else +use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz +#endif +use pyplot_module, only : pyplot +use wenoof, only : interpolator_object, wenoof_create +use wenoof_test_ui, only : test_ui + +implicit none +private +public :: test + +real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. + +type :: solution_data + !< Class to handle solution data. + real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. + real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. + real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. + real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. + real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. + real(RPP), allocatable :: reconstruction(:) !< Reconstruction values [1:2,1:points_number]. + real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. + real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). + real(RPP) :: error_L2=0._RPP !< L2 norm of the numerical error. +endtype solution_data + +type :: test + !< Class to handle test(s). + !< + !< Test is driven by the Command Line Interface (CLI) options. + !< + !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. + private + type(test_ui) :: ui !< Command line interface handler. + type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. + real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. + contains + ! public methods + procedure, pass(self) :: execute !< Execute selected test(s). + ! private methods + procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. + procedure, pass(self), private :: analize_errors !< Analize errors. + procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. + procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. + procedure, pass(self), private :: perform !< Perform test(s). + procedure, pass(self), private :: save_results_and_plots !< Save results and plots. +endtype test + +contains + ! public methods + subroutine execute(self) + !< Execute test(s). + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + + call self%ui%get + if (trim(adjustl(self%ui%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine execute + + ! private methods + subroutine allocate_solution_data(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + + call self%deallocate_solution_data + allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) + if (self%ui%pn_number>1) then + allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) + self%accuracy = 0._RPP + endif + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%reconstruction( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_face = 0._RPP + self%solution(pn, s)%fx_face = 0._RPP + self%solution(pn, s)%dfx_cell = 0._RPP + self%solution(pn, s)%interpolations = 0._RPP + self%solution(pn, s)%reconstruction = 0._RPP + self%solution(pn, s)%si = 0._RPP + self%solution(pn, s)%weights = 0._RPP + enddo + enddo + endsubroutine allocate_solution_data + + subroutine compute_reference_solution(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%allocate_solution_data + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 2 * pi / self%ui%points_number(pn) + ! compute the values used for the interpolation/reconstruction of cos function: cell values + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) + enddo + ! values to which the interpolation/reconstruction should tend + do i = 1, self%ui%points_number(pn) + self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_face(1,i) = sin(self%solution(pn, s)%x_face(1,i)) + self%solution(pn, s)%fx_face(2,i) = sin(self%solution(pn, s)%x_face(2,i)) + self%solution(pn, s)%dfx_cell(i) = cos(self%solution(pn, s)%x_cell(i)) + enddo + enddo + enddo + endsubroutine compute_reference_solution + + subroutine deallocate_solution_data(self) + !< Deallocate solution data. + class(test), intent(inout) :: self !< Test. + + if (allocated(self%solution)) deallocate(self%solution) + if (allocated(self%accuracy)) deallocate(self%accuracy) + endsubroutine deallocate_solution_data + + subroutine perform(self) + !< Perform the test. + class(test), intent(inout) :: self !< Test. + real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. + real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. + class(interpolator_object), allocatable :: interpolator !< WENO interpolator. + real(RPP), allocatable :: stencil(:,:) !< Stencils used. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%compute_reference_solution + do s=1, self%ui%S_number + call wenoof_create(interpolator_type=trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + self%solution(pn, s)%reconstruction(i) = & + (self%solution(pn, s)%interpolations(2,i) - self%solution(pn, s)%interpolations(1,i))/self%solution(pn, s)%Dx + enddo + enddo + deallocate(stencil) + enddo + call self%analize_errors + call self%save_results_and_plots + endsubroutine perform + + subroutine save_results_and_plots(self) + !< Save results and plots. + class(test), intent(inout) :: self !< Test. + type(pyplot) :: plt !< Plot handler. + character(len=:), allocatable :: buffer !< Buffer string. + character(len=:), allocatable :: output_dir !< Output directory. + character(len=:), allocatable :: file_bname !< File base name. + integer(I_P) :: file_unit !< File unit. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + integer(I_P) :: ss !< Counter. + integer(I_P) :: f !< Counter. + + output_dir = trim(adjustl(self%ui%output_dir))//'/' + if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-'//trim(adjustl(self%ui%interpolator_type)) + + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "sin(x)" "cos(x)" "x_left" "x_right" "sin(x)_left" "sin(x)_right"' + buffer = buffer//' "reconstruction_left" "reconstruction_right" "cos_reconstruction"' + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' + enddo + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + dfx_cell => self%solution(pn, s)%dfx_cell, & + x_face => self%solution(pn, s)%x_face, & + fx_face => self%solution(pn, s)%fx_face, & + interpolations => self%solution(pn, s)%interpolations, & + reconstruction => self%solution(pn, s)%reconstruction, & + si => self%solution(pn, s)%si, & + weights => self%solution(pn, s)%weights, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + dfx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (interpolations(f,i), f=1, 2), & + reconstruction(i), & + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + self%solution(pn, s)%error_L2, & + self%accuracy(pn, s), & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + +#ifndef r16p + ! pyplot fortran does not support 128 bit reals + if (self%ui%plots) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + buffer = 'WENO reconstruction of $d \sin(x)/Dx=\cos(x)$; '//& + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%dfx_cell(:), & + label='$\cos(x)$', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%reconstruction(:), & + label='WENO reconstruction', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') + enddo + enddo + endif +#endif + endsubroutine save_results_and_plots + + subroutine analize_errors(self) + !< Analize errors. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + if (self%ui%errors_analysis) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + dfx_cell=>self%solution(pn, s)%dfx_cell, & + reconstruction=>self%solution(pn, s)%reconstruction) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + error_L2 = error_L2 + (reconstruction(i) - dfx_cell(i))**2 + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + endif + endif + endsubroutine analize_errors +endmodule cos_test_module + +program cos_reconstruction +!< WenOOF test: reconstruction of cosine function. + +use cos_test_module + +implicit none +type(test) :: cos_test + +call cos_test%execute +endprogram cos_reconstruction diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 new file mode 100644 index 0000000..1d34ca1 --- /dev/null +++ b/src/tests/wenoof_test_ui.f90 @@ -0,0 +1,128 @@ +!< WenOOF test UI: definition of common User Interface (UI) for WenOOF tests. +module wenoof_test_ui +!< WenOOF test UI: definition of common User Interface (UI) for WenOOF tests. + +use flap, only : command_line_interface +#ifdef r16p +use penf, only: I_P, RPP=>R16P, FRPP=>FR16P +#else +use penf, only: I_P, RPP=>R8P, FRPP=>FR8P +#endif + +implicit none +private +public :: test_ui + +character(99), parameter :: interpolators(1:4) = ["JS ", & + "M-JS", & + "M-Z ", & + "Z "] !< List of available interpolators. + +type :: test_ui + !< Class to handle test(s) User Interface (UI). + type(command_line_interface) :: cli !< Command line interface handler. + integer(I_P) :: error=0 !< Error handler. + character(99) :: approximation_type='reconstruction' !< Action performed. + character(99) :: interpolator_type='JS' !< Interpolator used. + character(99) :: output_bname='unset' !< Output files basename. + character(99) :: output_dir='' !< Output directory. + integer(I_P) :: pn_number !< Number of different points-number tested. + integer(I_P), allocatable :: points_number(:) !< Points number used to discretize the domain. + integer(I_P) :: S_number !< Number of different stencils tested. + integer(I_P), allocatable :: S(:) !< Stencils used. + real(RPP) :: eps !< Smal episol to avoid zero-division. + logical :: errors_analysis=.false. !< Flag for activating errors analysis. + logical :: plots=.false. !< Flag for activating plots saving. + logical :: results=.false. !< Flag for activating results saving. + logical :: verbose=.false. !< Flag for activating verbose output. + contains + ! public methods + procedure, pass(self) :: get !< Get user options. + procedure, pass(self) :: loop_interpolator !< Loop over available interpolators. +endtype test_ui + +contains + ! public methods + subroutine get(self) + !< Get user options. + class(test_ui), intent(inout) :: self !< Test UI. + + call set_cli + call parse_cli + contains + subroutine set_cli() + !< Set Command Line Interface. + + associate(cli => self%cli) + call cli%init(progname = 'WenOOF Test', & + authors = 'Fortran-FOSS-Programmers', & + license = 'GNU GPLv3', & + description = 'Test WenOOF library on function reconstruction', & + examples = ["$EXECUTABLE --action I --interpolator JS --results", & + "$EXECUTABLE --action I --interpolator JS-Z -r ", & + "$EXECUTABLE --action R --interpolator JS-M ", & + "$EXECUTABLE --action R --interpolator all -p -r "]) + call cli%add(switch='--approximation', switch_ab='-a', help='WENO action', required=.false., & + def='reconstruction', act='store', choices='both,reconstruction,interpolation') & + call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator/recontructor type', required=.false., & + def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') + call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & + required=.false., act='store', def='50 100') + call cli%add(switch='--stencils', switch_ab='-s', nargs='+', help='Stencils dimensions (and number)', & + required=.false., act='store', def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') + call cli%add(switch='--eps', help='Small epsilon to avoid zero-division', required=.false., act='store', def='1.e-6') + call cli%add(switch='--output_dir', help='Output directory', required=.false., act='store', def='./') + call cli%add(switch='--results', switch_ab='-r', help='Save results', required=.false., act='store_true', def='.false.') + call cli%add(switch='--plots', switch_ab='-p', help='Save plots', required=.false., act='store_true', def='.false.') + call cli%add(switch='--output', help='Output files basename', required=.false., act='store', def='output') + call cli%add(switch='--errors_analysis', help='Peform errors analysis', required=.false., act='store_true', def='.false.') + call cli%add(switch='--verbose', help='Verbose output', required=.false., act='store_true', def='.false.') + endassociate + endsubroutine set_cli + + subroutine parse_cli() + !< Parse Command Line Interface and check its validity. + + call self%cli%parse(error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-a', val=self%action_type, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop + call self%cli%get_varying(switch='-pn', val=self%points_number, error=self%error) ; if (self%error/=0) stop + call self%cli%get_varying(switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--output_dir', val=self%output_dir, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--errors_analysis', val=self%errors_analysis, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop + + self%pn_number = size(self%points_number, dim=1) + self%S_number = size(self%S, dim=1) + endsubroutine parse_cli + endsubroutine get + + function loop_interpolator(self, interpolator) result(again) + !< Loop over available interpolators. + class(test_ui), intent(in) :: self !< Test UI. + character(99), intent(out) :: interpolator !< Interpolator name. + logical :: again !< Flag continuing the loop. + integer(I_P), save :: i = 0 !< Counter. + + again = .false. + if (i==0) then + i = 1 + interpolator = 'interpolator-'trim(adjustl(interpolators(i))) + interpolator = 'reconstructor-'trim(adjustl(interpolators(i))) + again = .true. + elseif (i Date: Mon, 13 Feb 2017 09:30:39 +0100 Subject: [PATCH 10/90] Remove unnecessaty test Short description Why: * This change addresses the need by: * Side effects: * --- src/tests/sin_reconstruction.f90 | 406 ------------------------------- 1 file changed, 406 deletions(-) delete mode 100644 src/tests/sin_reconstruction.f90 diff --git a/src/tests/sin_reconstruction.f90 b/src/tests/sin_reconstruction.f90 deleted file mode 100644 index caa1ad1..0000000 --- a/src/tests/sin_reconstruction.f90 +++ /dev/null @@ -1,406 +0,0 @@ -!< WenOOF test: reconstruction of sin function. -module sin_test_module -!< Auxiliary module defining the test class. - -use flap, only : command_line_interface -#ifdef r16p -use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz -#else -use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz -#endif -use pyplot_module, only : pyplot -use wenoof, only : interpolator_object, wenoof_create - -implicit none -private -public :: test - -character(99), parameter :: interpolators(1:5) = ["all ", & - "reconstructor-JS ", & - "reconstructor-M-JS", & - "reconstructor-M-Z ", & - "reconstructor-Z "] !< List of available interpolators. -real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. - -type :: solution_data - !< Class to handle solution data. - real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. - real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. - real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. - real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. - real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. - real(RPP), allocatable :: interpolation(:,:) !< Interpolated values [1:2,1:points_number]. - real(RPP), allocatable :: reconstruction(:,:) !< Reconstruction values [1:2,1:points_number]. - real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. - real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). - real(RPP) :: error_L2=0._RPP !< L2 norm of the numerical error. -endtype solution_data - -type :: test - !< Class to handle test(s). - !< - !< Test is driven by the Command Line Interface (CLI) options. - !< - !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. - private - type(command_line_interface) :: cli !< Command line interface handler. - integer(I_P) :: error=0 !< Error handler. - character(99) :: interpolator_type='JS' !< Interpolator used. - character(99) :: output_bname='unset' !< Output files basename. - character(99) :: output_dir='' !< Output directory. - integer(I_P) :: pn_number !< Number of different points-number tested. - integer(I_P), allocatable :: points_number(:) !< Points number used to discretize the domain. - integer(I_P) :: S_number !< Number of different stencils tested. - integer(I_P), allocatable :: S(:) !< Stencils used. - real(RPP) :: eps !< Smal episol to avoid zero-division. - type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. - real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. - logical :: errors_analysis=.false. !< Flag for activating errors analysis. - logical :: plots=.false. !< Flag for activating plots saving. - logical :: results=.false. !< Flag for activating results saving. - logical :: verbose=.false. !< Flag for activating verbose output. - contains - ! public methods - procedure, pass(self) :: execute !< Execute selected test(s). - ! private methods - procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. - procedure, pass(self), private :: analize_errors !< Analize errors. - procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. - procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. - procedure, pass(self), private :: initialize !< Initialize test(s). - procedure, pass(self), private :: perform !< Perform test(s). - procedure, pass(self), private :: save_results_and_plots !< Save results and plots. -endtype test - -contains - ! public methods - subroutine execute(self) - !< Execute test(s). - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - - call self%initialize - if (trim(adjustl(self%interpolator_type))/='all') then - call self%perform - else - do s=2, size(interpolators, dim=1) - self%interpolator_type = trim(adjustl(interpolators(s))) - call self%perform - enddo - endif - endsubroutine execute - - ! private methods - subroutine allocate_solution_data(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - - call self%deallocate_solution_data - self%pn_number = size(self%points_number, dim=1) - self%S_number = size(self%S, dim=1) - allocate(self%solution(1:self%pn_number, 1:self%S_number)) - if (self%pn_number>1) then - allocate(self%accuracy(1:self%pn_number, 1:self%S_number)) - self%accuracy = 0._RPP - endif - do s=1, self%S_number - do pn=1, self%pn_number - allocate(self%solution(pn, s)%x_cell( 1-self%S(s):self%points_number(pn)+self%S(s) )) - allocate(self%solution(pn, s)%fx_cell( 1-self%S(s):self%points_number(pn)+self%S(s) )) - allocate(self%solution(pn, s)%x_face( 1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%fx_face( 1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%dfx_cell( 1:self%points_number(pn) )) - allocate(self%solution(pn, s)%interpolation( 1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%reconstruction(1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%si( 1:2,1:self%points_number(pn), 0:self%S(s)-1)) - allocate(self%solution(pn, s)%weights( 1:2,1:self%points_number(pn), 0:self%S(s)-1)) - self%solution(pn, s)%x_cell = 0._RPP - self%solution(pn, s)%fx_cell = 0._RPP - self%solution(pn, s)%x_face = 0._RPP - self%solution(pn, s)%fx_face = 0._RPP - self%solution(pn, s)%dfx_cell = 0._RPP - self%solution(pn, s)%interpolation = 0._RPP - self%solution(pn, s)%reconstruction = 0._RPP - self%solution(pn, s)%si = 0._RPP - self%solution(pn, s)%weights = 0._RPP - enddo - enddo - endsubroutine allocate_solution_data - - subroutine compute_reference_solution(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%allocate_solution_data - do s=1, self%S_number - do pn=1, self%pn_number - self%solution(pn, s)%Dx = 2 * pi / self%points_number(pn) - ! compute the values used for the interpolation/reconstruction of sin function: cell values - do i=1 - self%S(s), self%points_number(pn) + self%S(s) - self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) - enddo - ! values to which the interpolation/reconstruction should tend - do i = 1, self%points_number(pn) - self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = sin(self%solution(pn, s)%x_face(1,i)) - self%solution(pn, s)%fx_face(2,i) = sin(self%solution(pn, s)%x_face(2,i)) - self%solution(pn, s)%dfx_cell(i) = cos(self%solution(pn, s)%x_cell(i)) - enddo - enddo - enddo - endsubroutine compute_reference_solution - - subroutine deallocate_solution_data(self) - !< Deallocate solution data. - class(test), intent(inout) :: self !< Test. - - if (allocated(self%solution)) deallocate(self%solution) - if (allocated(self%accuracy)) deallocate(self%accuracy) - endsubroutine deallocate_solution_data - - subroutine initialize(self) - !< Initialize test: set Command Line Interface, parse it and check its validity. - class(test), intent(inout) :: self !< Test. - - call set_cli - call parse_cli - contains - subroutine set_cli() - !< Set Command Line Interface. - - associate(cli => self%cli) - call cli%init(progname = 'sin reconstruction', & - authors = 'Fortran-FOSS-Programmers', & - license = 'GNU GPLv3', & - description = 'Test WenOOF library on sin function reconstruction', & - examples = ["sin_reconstruction --interpolator JS --results", & - "sin_reconstruction --interpolator JS-Z -r ", & - "sin_reconstruction --interpolator JS-M ", & - "sin_reconstruction --interpolator all -p -r "]) - call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator type', required=.false., & - def='reconstructor-JS', act='store', & - choices='all,reconstructor-JS,reconstructor-M-JS,reconstructor-M-Z,reconstructor-Z') - call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & - required=.false., act='store', def='50 100') - call cli%add(switch='--stencils', switch_ab='-s', nargs='+', help='Stencils dimensions (and number)', & - required=.false., act='store', def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') - call cli%add(switch='--eps', help='Small epsilon to avoid zero-division', required=.false., act='store', def='1.e-6') - call cli%add(switch='--output_dir', help='Output directory', required=.false., act='store', def='./') - call cli%add(switch='--results', switch_ab='-r', help='Save results', required=.false., act='store_true', def='.false.') - call cli%add(switch='--plots', switch_ab='-p', help='Save plots', required=.false., act='store_true', def='.false.') - call cli%add(switch='--output', help='Output files basename', required=.false., act='store', def='sin_reconstruction') - call cli%add(switch='--errors_analysis', help='Peform errors analysis', required=.false., act='store_true', def='.false.') - call cli%add(switch='--verbose', help='Verbose output', required=.false., act='store_true', def='.false.') - endassociate - endsubroutine set_cli - - subroutine parse_cli() - !< Parse Command Line Interface and check its validity. - character(len=:), allocatable :: valid_solvers_list !< Pretty printed list of available solvers. - - call self%cli%parse(error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(switch='-pn', val=self%points_number, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--output_dir', val=self%output_dir, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--errors_analysis', val=self%errors_analysis, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop - endsubroutine parse_cli - endsubroutine initialize - - subroutine perform(self) - !< Perform the test. - class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. - class(interpolator_object), allocatable :: interpolator !< WENO interpolator. - real(RPP), allocatable :: stencil(:,:) !< Stencils used. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%compute_reference_solution - do s=1, self%S_number - call wenoof_create(interpolator_type=trim(adjustl(self%interpolator_type)), & - S=self%S(s), & - interpolator=interpolator, & - eps=self%eps) - if (self%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%S(s):-1+self%S(s))) - do pn=1, self%pn_number - do i=1, self%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%reconstruction(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%S(s)-1)) - enddo - enddo - deallocate(stencil) - enddo - call self%analize_errors - call self%save_results_and_plots - endsubroutine perform - - subroutine save_results_and_plots(self) - !< Save results and plots. - class(test), intent(inout) :: self !< Test. - type(pyplot) :: plt !< Plot handler. - character(len=:), allocatable :: buffer !< Buffer string. - character(len=:), allocatable :: output_dir !< Output directory. - character(len=:), allocatable :: file_bname !< File base name. - integer(I_P) :: file_unit !< File unit. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: ss !< Counter. - integer(I_P) :: f !< Counter. - - output_dir = trim(adjustl(self%output_dir))//'/' - if (self%results.or.self%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%output_bname))//'-'//trim(adjustl(self%interpolator_type)) - - if (self%results) then - do s=1, self%S_number - do pn=1, self%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%S(s), .true.))//& - '-Np_'//trim(str(self%points_number(pn), .true.))//'.dat') - buffer = 'VARIABLES = "x" "sin(x)" "cos(x)" "x_left" "x_right" "sin(x)_left" "sin(x)_right"' - buffer = buffer//' "reconstruction_left" "reconstruction_right" "cos_reconstruction"' - do ss=0, self%S(s)-1 - buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' - enddo - do ss=0, self%S(s)-1 - buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' - enddo - write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%S(s), .true.))//& - '-Np_'//trim(str(self%points_number(pn), .true.))//'"' - associate(x_cell => self%solution(pn, s)%x_cell, & - fx_cell => self%solution(pn, s)%fx_cell, & - dfx_cell => self%solution(pn, s)%dfx_cell, & - x_face => self%solution(pn, s)%x_face, & - fx_face => self%solution(pn, s)%fx_face, & - reconstruction => self%solution(pn, s)%reconstruction, & - si => self%solution(pn, s)%si, & - weights => self%solution(pn, s)%weights, & - Dx => self%solution(pn, s)%Dx) - do i = 1, self%points_number(pn) - write(file_unit, "("//trim(str(10+4*self%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - dfx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (reconstruction(f,i), f=1, 2), & - (reconstruction(2,i)-reconstruction(1,i))/Dx, & - ((si(f, i, ss), f=1, 2), ss=0, self%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%S(s)-1) - enddo - endassociate - close(file_unit) - enddo - enddo - - if (self%errors_analysis.and.self%pn_number>1) then - open(newunit=file_unit, file=file_bname//'-accuracy.dat') - write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' - do s=1, self%S_number - do pn=1, self%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%S(s), & - self%points_number(pn), & - self%solution(pn, s)%error_L2, & - self%accuracy(pn, s), & - 2*self%S(s)-1 - enddo - enddo - close(file_unit) - endif - endif - -#ifndef r16p - ! pyplot fortran does not support 128 bit reals - if (self%plots) then - do s=1, self%S_number - do pn=1, self%pn_number - buffer = 'WENO reconstruction of $d \sin(x)/Dx=\cos(x)$; '//& - 'S='//trim(str(self%S(s), .true.))//'Np='//trim(str(self%points_number(pn), .true.)) - call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%points_number(pn)), & - y=self%solution(pn, s)%dfx_cell(:), & - label='$\sin(x)$', & - linestyle='k-', & - linewidth=2, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%points_number(pn)), & - y=(self%solution(pn, s)%reconstruction(2,:)-self%solution(pn, s)%reconstruction(1,:))/ & - self%solution(pn, s)%Dx, & - label='WENO reconstruction', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%savefig(file_bname//& - '-S_'//trim(str(self%S(s), .true.))//'-Np_'//trim(str(self%points_number(pn), .true.))//'.png') - enddo - enddo - endif -#endif - endsubroutine save_results_and_plots - - subroutine analize_errors(self) - !< Analize errors. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - if (self%errors_analysis) then - do s=1, self%S_number - do pn=1, self%pn_number - associate(error_L2=>self%solution(pn, s)%error_L2, & - Dx=>self%solution(pn, s)%Dx, & - dfx_cell=>self%solution(pn, s)%dfx_cell, & - reconstruction=>self%solution(pn, s)%reconstruction) - error_L2 = 0._RPP - do i=1, self%points_number(pn) - error_L2 = error_L2 + ((reconstruction(2,i)-reconstruction(1,i))/Dx - dfx_cell(i))**2 - enddo - error_L2 = sqrt(error_L2) - endassociate - enddo - enddo - if (self%pn_number>1) then - do s=1, self%S_number - do pn=2, self%pn_number - self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & - log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) - enddo - enddo - endif - endif - endsubroutine analize_errors -endmodule sin_test_module - -program sin_reconstruction -!< WenOOF test: reconstruction of sin function. - -use sin_test_module - -implicit none -type(test) :: sin_test - -call sin_test%execute -endprogram sin_reconstruction From ef5f56e25b128a96e6815bd14d0e963ef29bfa9d Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 16 Feb 2017 15:24:36 +0100 Subject: [PATCH 11/90] Modify test-ui Short description Why: Modify test ui for both reconstruction and interpolation This change addresses the need by: * Side effects: * --- src/tests/wenoof_test_ui.f90 | 19 +++++++------------ 1 file changed, 7 insertions(+), 12 deletions(-) diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 index 1d34ca1..023f64e 100644 --- a/src/tests/wenoof_test_ui.f90 +++ b/src/tests/wenoof_test_ui.f90 @@ -22,7 +22,6 @@ module wenoof_test_ui !< Class to handle test(s) User Interface (UI). type(command_line_interface) :: cli !< Command line interface handler. integer(I_P) :: error=0 !< Error handler. - character(99) :: approximation_type='reconstruction' !< Action performed. character(99) :: interpolator_type='JS' !< Interpolator used. character(99) :: output_bname='unset' !< Output files basename. character(99) :: output_dir='' !< Output directory. @@ -62,8 +61,6 @@ subroutine set_cli() "$EXECUTABLE --action I --interpolator JS-Z -r ", & "$EXECUTABLE --action R --interpolator JS-M ", & "$EXECUTABLE --action R --interpolator all -p -r "]) - call cli%add(switch='--approximation', switch_ab='-a', help='WENO action', required=.false., & - def='reconstruction', act='store', choices='both,reconstruction,interpolation') & call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator/recontructor type', required=.false., & def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & @@ -84,7 +81,6 @@ subroutine parse_cli() !< Parse Command Line Interface and check its validity. call self%cli%parse(error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-a', val=self%action_type, error=self%error) ; if (self%error/=0) stop call self%cli%get(switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop call self%cli%get_varying(switch='-pn', val=self%points_number, error=self%error) ; if (self%error/=0) stop call self%cli%get_varying(switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop @@ -103,21 +99,20 @@ subroutine parse_cli() function loop_interpolator(self, interpolator) result(again) !< Loop over available interpolators. - class(test_ui), intent(in) :: self !< Test UI. - character(99), intent(out) :: interpolator !< Interpolator name. - logical :: again !< Flag continuing the loop. - integer(I_P), save :: i = 0 !< Counter. + class(test_ui), intent(in) :: self !< Test UI. + character(99), intent(out) :: interpolator !< Interpolator name. + character(99), :: approximation !< Approximation type. + logical :: again !< Flag continuing the loop. + integer(I_P), save :: i = 0 !< Counter. again = .false. if (i==0) then i = 1 - interpolator = 'interpolator-'trim(adjustl(interpolators(i))) - interpolator = 'reconstructor-'trim(adjustl(interpolators(i))) + interpolator = trim(adjustl(interpolators(i))) again = .true. elseif (i Date: Thu, 16 Feb 2017 15:46:50 +0100 Subject: [PATCH 12/90] Add interpolation of sin function test Short description Why: * This change addresses the need by: * Side effects: * --- src/tests/sin_interpolation.f90 | 330 ++++++++++++++++++++++++++++++++ 1 file changed, 330 insertions(+) create mode 100644 src/tests/sin_interpolation.f90 diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 new file mode 100644 index 0000000..13bfc10 --- /dev/null +++ b/src/tests/sin_interpolation.f90 @@ -0,0 +1,330 @@ +!< WenOOF test: interpolation of sine function. +module sin_test_module +!< Auxiliary module defining the test class. + +use flap, only : command_line_interface +#ifdef r16p +use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz +#else +use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz +#endif +use pyplot_module, only : pyplot +use wenoof, only : interpolator_object, wenoof_create +use wenoof_test_ui, only : test_ui + +implicit none +private +public :: test + +real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. + +type :: solution_data + !< Class to handle solution data. + real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. + real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. + real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. + real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. + real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. + real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). + real(RPP) :: error_L2(:)=0._RPP !< L2 norm of the numerical error [1:2]. +endtype solution_data + +type :: test + !< Class to handle test(s). + !< + !< Test is driven by the Command Line Interface (CLI) options. + !< + !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. + private + type(test_ui) :: ui !< Command line interface handler. + type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. + real(RPP), allocatable :: accuracy(:,:,:) !< Accuracy (measured) [1:2, 1:pn_number-1, 1:S_number]. + contains + ! public methods + procedure, pass(self) :: execute !< Execute selected test(s). + ! private methods + procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. + procedure, pass(self), private :: analize_errors !< Analize errors. + procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. + procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. + procedure, pass(self), private :: perform !< Perform test(s). + procedure, pass(self), private :: save_results_and_plots !< Save results and plots. +endtype test + +contains + ! public methods + subroutine execute(self) + !< Execute test(s). + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + + call self%ui%get + if (trim(adjustl(self%ui%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine execute + + ! private methods + subroutine allocate_solution_data(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + + call self%deallocate_solution_data + allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) + if (self%ui%pn_number>1) then + allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) + self%accuracy = 0._RPP + endif + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_face = 0._RPP + self%solution(pn, s)%fx_face = 0._RPP + self%solution(pn, s)%interpolations = 0._RPP + self%solution(pn, s)%si = 0._RPP + self%solution(pn, s)%weights = 0._RPP + enddo + enddo + endsubroutine allocate_solution_data + + subroutine compute_reference_solution(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%allocate_solution_data + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 2 * pi / self%ui%points_number(pn) + ! compute the values used for the interpolation of sin function: cell values + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) + enddo + ! values to which the interpolation/reconstruction should tend + do i = 1, self%ui%points_number(pn) + self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_face(1,i) = sin(self%solution(pn, s)%x_face(1,i)) + self%solution(pn, s)%fx_face(2,i) = sin(self%solution(pn, s)%x_face(2,i)) + enddo + enddo + enddo + endsubroutine compute_reference_solution + + subroutine deallocate_solution_data(self) + !< Deallocate solution data. + class(test), intent(inout) :: self !< Test. + + if (allocated(self%solution)) deallocate(self%solution) + if (allocated(self%accuracy)) deallocate(self%accuracy) + endsubroutine deallocate_solution_data + + subroutine perform(self) + !< Perform the test. + class(test), intent(inout) :: self !< Test. + real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. + real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. + class(interpolator_object), allocatable :: interpolator !< WENO interpolator. + real(RPP), allocatable :: stencil(:,:) !< Stencils used. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%compute_reference_solution + do s=1, self%ui%S_number + call wenoof_create(interpolator_type='interpolator-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + enddo + enddo + deallocate(stencil) + enddo + call self%analize_errors + call self%save_results_and_plots + endsubroutine perform + + subroutine save_results_and_plots(self) + !< Save results and plots. + class(test), intent(inout) :: self !< Test. + type(pyplot) :: plt !< Plot handler. + character(len=:), allocatable :: buffer !< Buffer string. + character(len=:), allocatable :: output_dir !< Output directory. + character(len=:), allocatable :: file_bname !< File base name. + integer(I_P) :: file_unit !< File unit. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + integer(I_P) :: ss !< Counter. + integer(I_P) :: f !< Counter. + + output_dir = trim(adjustl(self%ui%output_dir))//'/' + if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-interpolator-'//trim(adjustl(self%ui%interpolator_type)) + + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "sin(x)" "x_left" "x_right" "sin(x)_left" "sin(x)_right"' + buffer = buffer//' "interpolation_left" "interpolation_right"' + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' + enddo + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + x_face => self%solution(pn, s)%x_face, & + fx_face => self%solution(pn, s)%fx_face, & + interpolations => self%solution(pn, s)%interpolations, & + si => self%solution(pn, s)%si, & + weights => self%solution(pn, s)%weights, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (interpolations(f,i), f=1, 2), & + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + (self%solution(pn, s)%error_L2(f), f=1, 2) & + (self%accuracy(pn, s), f=1, 2) & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + +#ifndef r16p + ! pyplot fortran does not support 128 bit reals + if (self%ui%plots) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + buffer = 'WENO interpolation of $\sin(x)$; '//& + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%fx_cell(:), & + label='$\sin(x)$', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_face(1,1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%interpolations(1,:), & + label='WENO interpolation left', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_face(2,1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%interpolations(2,:), & + label='WENO interpolation right', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') + enddo + enddo + endif +#endif + endsubroutine save_results_and_plots + + subroutine analize_errors(self) + !< Analize errors. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + if (self%ui%errors_analysis) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + fx_face=>self%solution(pn, s)%fx_face, & + interpolations=>self%solution(pn, s)%interpolations) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + do f=1,2 + error_L2(f) = error_L2(f) + (interpolations(f,i) - fx_face(f,i))**2 + enddo + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + do f=1,2 + self%accuracy(f, pn, s) = log(self%solution(pn - 1, s)%error_L2(f) / self%solution(pn, s)%error_L2(f)) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + enddo + endif + endif + endsubroutine analize_errors +endmodule sin_test_module + +program sin_interpolation +!< WenOOF test: interpolation of sine function. + +use sin_test_module + +implicit none +type(test) :: sin_test + +call sin_test%execute +endprogram sin_interpolation From 5859a068de13c96d0f469b45d85d19a945fcc2a1 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 16 Feb 2017 15:52:26 +0100 Subject: [PATCH 13/90] Minor fixes. Still not compiling Short description Why: * This change addresses the need by: * Side effects: * --- src/tests/sin_interpolation.f90 | 9 ++++++--- src/tests/wenoof_test_ui.f90 | 2 +- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 index 13bfc10..1f88a6a 100644 --- a/src/tests/sin_interpolation.f90 +++ b/src/tests/sin_interpolation.f90 @@ -28,7 +28,7 @@ module sin_test_module real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). - real(RPP) :: error_L2(:)=0._RPP !< L2 norm of the numerical error [1:2]. + real(RPP), allocatable :: error_L2(:) !< L2 norm of the numerical error [1:2]. endtype solution_data type :: test @@ -80,7 +80,7 @@ subroutine allocate_solution_data(self) call self%deallocate_solution_data allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) if (self%ui%pn_number>1) then - allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) + allocate(self%accuracy(1:2, 1:self%ui%pn_number, 1:self%ui%S_number)) self%accuracy = 0._RPP endif do s=1, self%ui%S_number @@ -92,6 +92,7 @@ subroutine allocate_solution_data(self) allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%error_L2( 1:2 )) self%solution(pn, s)%x_cell = 0._RPP self%solution(pn, s)%fx_cell = 0._RPP self%solution(pn, s)%x_face = 0._RPP @@ -99,6 +100,7 @@ subroutine allocate_solution_data(self) self%solution(pn, s)%interpolations = 0._RPP self%solution(pn, s)%si = 0._RPP self%solution(pn, s)%weights = 0._RPP + self%solution(pn, s)%error_L2 = 0._RPP enddo enddo endsubroutine allocate_solution_data @@ -238,7 +240,7 @@ subroutine save_results_and_plots(self) write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & self%ui%points_number(pn), & (self%solution(pn, s)%error_L2(f), f=1, 2) & - (self%accuracy(pn, s), f=1, 2) & + (self%accuracy(f, pn, s), f=1, 2) & 2*self%ui%S(s)-1 enddo enddo @@ -286,6 +288,7 @@ subroutine analize_errors(self) integer(I_P) :: s !< Counter. integer(I_P) :: pn !< Counter. integer(I_P) :: i !< Counter. + integer(I_P) :: f !< Counter. if (self%ui%errors_analysis) then do s=1, self%ui%S_number diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 index 023f64e..6a2ac90 100644 --- a/src/tests/wenoof_test_ui.f90 +++ b/src/tests/wenoof_test_ui.f90 @@ -101,7 +101,7 @@ function loop_interpolator(self, interpolator) result(again) !< Loop over available interpolators. class(test_ui), intent(in) :: self !< Test UI. character(99), intent(out) :: interpolator !< Interpolator name. - character(99), :: approximation !< Approximation type. + character(99) :: approximation !< Approximation type. logical :: again !< Flag continuing the loop. integer(I_P), save :: i = 0 !< Counter. From 1e31680342ff7c3bbd5f29f636836d4d65317dbb Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 17 Feb 2017 12:05:41 +0100 Subject: [PATCH 14/90] First running version of sin_interpolation Short description Why: * This change addresses the need by: * Side effects: * --- src/lib/factories/wenoof_alpha_factory.f90 | 17 ++++++++++++-- src/lib/factories/wenoof_weights_factory.f90 | 9 ++++++-- src/tests/sin_interpolation.f90 | 24 ++++++++++---------- src/tests/wenoof_test_ui.f90 | 8 +++---- 4 files changed, 38 insertions(+), 20 deletions(-) diff --git a/src/lib/factories/wenoof_alpha_factory.f90 b/src/lib/factories/wenoof_alpha_factory.f90 index 014b2e1..9c12e75 100644 --- a/src/lib/factories/wenoof_alpha_factory.f90 +++ b/src/lib/factories/wenoof_alpha_factory.f90 @@ -54,8 +54,21 @@ subroutine create_constructor(interpolator_type, S, constructor, face_left, face select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - ! @TODO implement this - error stop 'interpolator-JS to be implemented' + allocate(alpha_rec_js_constructor :: constructor) + case('interpolator-M-JS') + allocate(alpha_rec_m_constructor :: constructor) + select type(constructor) + type is(alpha_rec_m_constructor) + constructor%base_type = 'JS' + endselect + case('interpolator-M-Z') + allocate(alpha_rec_m_constructor :: constructor) + select type(constructor) + type is(alpha_rec_m_constructor) + constructor%base_type = 'Z' + endselect + case('interpolator-Z') + allocate(alpha_rec_z_constructor :: constructor) case('reconstructor-JS') allocate(alpha_rec_js_constructor :: constructor) case('reconstructor-M-JS') diff --git a/src/lib/factories/wenoof_weights_factory.f90 b/src/lib/factories/wenoof_weights_factory.f90 index 873dda9..21911c3 100644 --- a/src/lib/factories/wenoof_weights_factory.f90 +++ b/src/lib/factories/wenoof_weights_factory.f90 @@ -50,8 +50,13 @@ subroutine create_constructor(interpolator_type, S, alpha_constructor, beta_cons select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - ! @TODO implement this - error stop 'interpolator-JS to be implemented' + allocate(weights_js_constructor :: constructor) + case('interpolator-M-JS') + allocate(weights_js_constructor :: constructor) + case('interpolator-M-Z') + allocate(weights_js_constructor :: constructor) + case('interpolator-Z') + allocate(weights_js_constructor :: constructor) case('reconstructor-JS') allocate(weights_js_constructor :: constructor) case('reconstructor-M-JS') diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 index 1f88a6a..953b328 100644 --- a/src/tests/sin_interpolation.f90 +++ b/src/tests/sin_interpolation.f90 @@ -218,13 +218,13 @@ subroutine save_results_and_plots(self) weights => self%solution(pn, s)%weights, & Dx => self%solution(pn, s)%Dx) do i = 1, self%ui%points_number(pn) - write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (interpolations(f,i), f=1, 2), & - ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + write(file_unit, "("//trim(str(8+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (interpolations(f,i), f=1, 2), & + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) enddo endassociate @@ -234,13 +234,13 @@ subroutine save_results_and_plots(self) if (self%ui%errors_analysis.and.self%ui%pn_number>1) then open(newunit=file_unit, file=file_bname//'-accuracy.dat') - write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2) L" "error (L2) R" "obs order L" "obs order R" "formal order"' do s=1, self%ui%S_number do pn=1, self%ui%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & - self%ui%points_number(pn), & - (self%solution(pn, s)%error_L2(f), f=1, 2) & - (self%accuracy(f, pn, s), f=1, 2) & + write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + (self%solution(pn, s)%error_L2(f), f=1, 2), & + (self%accuracy(f, pn, s), f=1, 2), & 2*self%ui%S(s)-1 enddo enddo diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 index 6a2ac90..a465e97 100644 --- a/src/tests/wenoof_test_ui.f90 +++ b/src/tests/wenoof_test_ui.f90 @@ -57,10 +57,10 @@ subroutine set_cli() authors = 'Fortran-FOSS-Programmers', & license = 'GNU GPLv3', & description = 'Test WenOOF library on function reconstruction', & - examples = ["$EXECUTABLE --action I --interpolator JS --results", & - "$EXECUTABLE --action I --interpolator JS-Z -r ", & - "$EXECUTABLE --action R --interpolator JS-M ", & - "$EXECUTABLE --action R --interpolator all -p -r "]) + examples = ["$EXECUTABLE --interpolator JS --results", & + "$EXECUTABLE --interpolator JS-Z -r ", & + "$EXECUTABLE --interpolator JS-M ", & + "$EXECUTABLE --interpolator all -p -r "]) call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator/recontructor type', required=.false., & def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & From 04ca4b3a75170aada83dbd4a510de5d6e0783c79 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 20 Feb 2017 09:46:55 +0100 Subject: [PATCH 15/90] Update test for interpolations Short description Why: * This change addresses the need by: * Side effects: * --- src/tests/polynoms_interpolation.f90 | 360 ++++++++++++++++++++++++++ src/tests/polynoms_reconstruction.f90 | 129 ++------- src/tests/sin_interpolation.f90 | 22 +- 3 files changed, 397 insertions(+), 114 deletions(-) create mode 100644 src/tests/polynoms_interpolation.f90 diff --git a/src/tests/polynoms_interpolation.f90 b/src/tests/polynoms_interpolation.f90 new file mode 100644 index 0000000..450533b --- /dev/null +++ b/src/tests/polynoms_interpolation.f90 @@ -0,0 +1,360 @@ +!< WenOOF test: interpolation of polynomial functions. +module polynoms_int_test_module +!< Auxiliary module defining the test class. + +use flap, only : command_line_interface +#ifdef r16p +use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz +#else +use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz +#endif +use pyplot_module, only : pyplot +use wenoof, only : interpolator_object, wenoof_create +use wenoof_test_ui, only : test_ui + +implicit none +private +public :: test + +real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. + +type :: solution_data + !< Class to handle solution data. + real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. + real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. + real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. + real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. + real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. + real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). + real(RPP) :: error_L2(:) !< L2 norm of the numerical error. +endtype solution_data + +type :: test + !< Class to handle test(s). + !< + !< Test is driven by the Command Line Interface (CLI) options. + !< + !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. + private + type(test_ui) :: ui !< Command line interface handler. + type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. + real(RPP), allocatable :: accuracy(:,:,:) !< Accuracy (measured) [1:2, 1:pn_number-1, 1:S_number]. + contains + ! public methods + procedure, pass(self) :: execute !< Execute selected test(s). + ! private methods + procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. + procedure, pass(self), private :: analize_errors !< Analize errors. + procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. + procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. + procedure, pass(self), private :: perform !< Perform test(s). + procedure, pass(self), private :: save_results_and_plots !< Save results and plots. +endtype test + +contains + ! public methods + subroutine execute(self) + !< Execute test(s). + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + + call self%initialize + if (trim(adjustl(self%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine execute + + ! private methods + subroutine allocate_solution_data(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + + call self%deallocate_solution_data + allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) + if (self%ui%pn_number>1) then + allocate(self%accuracy(1:2, 1:self%ui%pn_number, 1:self%ui%S_number)) + self%accuracy = 0._RPP + endif + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%error_L2( 1:2 )) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_face = 0._RPP + self%solution(pn, s)%fx_face = 0._RPP + self%solution(pn, s)%interpolations = 0._RPP + self%solution(pn, s)%si = 0._RPP + self%solution(pn, s)%weights = 0._RPP + self%solution(pn, s)%error_L2 = 0._RPP + enddo + enddo + endsubroutine allocate_solution_data + + subroutine compute_reference_solution(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%allocate_solution_data + do s=1, self%S_number + do pn=1, self%pn_number + self%solution(pn, s)%Dx = 1._RPP / self%points_number(pn) + ! compute the values used for the interpolation of polynomials function: cell values + do i=1 - self%S(s), self%points_number(pn) + self%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%S(s)+2) + enddo + ! values to which the interpolation should tend + do i = 1, self%points_number(pn) + self%solution(pn, s)%x_face( 1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%x_face( 2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%S(s)+2) + self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%S(s)+2) + enddo + enddo + enddo + endsubroutine compute_reference_solution + + subroutine deallocate_solution_data(self) + !< Deallocate solution data. + class(test), intent(inout) :: self !< Test. + + if (allocated(self%solution)) deallocate(self%solution) + if (allocated(self%accuracy)) deallocate(self%accuracy) + endsubroutine deallocate_solution_data + + subroutine perform(self) + !< Perform the test. + class(test), intent(inout) :: self !< Test. + real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. + real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. + class(interpolator_object), allocatable :: interpolator !< WENO interpolator. + real(RPP), allocatable :: stencil(:,:) !< Stencils used. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%compute_reference_solution + do s=1, self%S_number + call wenoof_create(interpolator_type='interpolator-'trim(adjustl(self%interpolator_type)), & + S=self%S(s), & + interpolator=interpolator, & + eps=self%eps) + if (self%verbose) print '(A)', interpolator%description() + allocate(stencil(1:2, 1-self%S(s):-1+self%S(s))) + do pn=1, self%pn_number + do i=1, self%points_number(pn) + stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) + stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%reconstruction(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%S(s)-1)) + enddo + enddo + deallocate(stencil) + enddo + call self%analize_errors + call self%save_results_and_plots + endsubroutine perform + + subroutine save_results_and_plots(self) + !< Save results and plots. + class(test), intent(inout) :: self !< Test. + type(pyplot) :: plt !< Plot handler. + character(len=:), allocatable :: buffer !< Buffer string. + character(len=:), allocatable :: output_dir !< Output directory. + character(len=:), allocatable :: file_bname !< File base name. + integer(I_P) :: file_unit !< File unit. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + integer(I_P) :: ss !< Counter. + integer(I_P) :: f !< Counter. + + output_dir = trim(adjustl(self%output_dir))//'/' + if (self%results.or.self%plots) call execute_command_line('mkdir -p '//output_dir) + file_bname = output_dir//trim(adjustl(self%output_bname))//'-'//trim(adjustl(self%interpolator_type)) + + if (self%results) then + do s=1, self%S_number + do pn=1, self%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%S(s), .true.))//& + '-Np_'//trim(str(self%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "f(x)" "x_left" "x_right" "f(x)_left" "f(x)_right"' + buffer = buffer//' "interpolation_left" "interpolation_right"' + do ss=0, self%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' + enddo + do ss=0, self%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%S(s), .true.))//& + '-Np_'//trim(str(self%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + x_face => self%solution(pn, s)%x_face, & + fx_face => self%solution(pn, s)%fx_face, & + interpolations => self%solution(pn, s)%interpolations, & + si => self%solution(pn, s)%si, & + weights => self%solution(pn, s)%weights, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%points_number(pn) + write(file_unit, "("//trim(str(8+4*self%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (interpolations(f,i), f=1, 2), & + ((si(f, i, ss), f=1, 2), ss=0, self%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%errors_analysis.and.self%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2) L" "error (L2) R" "obs order L" "obs order R" "formal order"' + do s=1, self%S_number + do pn=1, self%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + (self%solution(pn, s)%error_L2(f), f=1, 2), & + (self%accuracy(f, pn, s), f=1, 2), & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + +#ifndef r16p + ! pyplot fortran does not support 128 bit reals + if (self%plots) then + do s=1, self%S_number + do pn=1, self%pn_number + buffer = 'WENO interpolation of polynomial function; '//& + 'S='//trim(str(self%S(s), .true.))//'Np='//trim(str(self%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%points_number(pn)), & + y=self%solution(pn, s)%dfx_cell(:), & + label='polynom', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_face(1,1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%interpolations(1,:), & + label='WENO interpolation left', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_face(2,1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%interpolations(2,:), & + label='WENO interpolation right', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%S(s), .true.))//'-Np_'//trim(str(self%points_number(pn), .true.))//'.png') + enddo + enddo + endif +#endif + endsubroutine save_results_and_plots + + subroutine analize_errors(self) + !< Analize errors. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + integer(I_P) :: f !< Counter. + + if (self%ui%errors_analysis) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + fx_face=>self%solution(pn, s)%fx_face, & + interpolations=>self%solution(pn, s)%interpolations) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + do f=1,2 + error_L2(f) = error_L2(f) + (interpolations(f,i) - fx_face(f,i))**2 + enddo + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + do f=1,2 + self%accuracy(f, pn, s) = log(self%solution(pn - 1, s)%error_L2(f) / self%solution(pn, s)%error_L2(f)) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + enddo + endif + endif + endsubroutine analize_errors + + ! non TBP + pure function interface_function(x, o) result(y) + !< Interface function. + real(RPP), intent(in) :: x !< X value. + integer(I_P), intent(in) :: o !< Polynomial order. + real(RPP) :: y !< Y value. + integer(I_P) :: i !< Counter. + + y = 0._RPP + do i=1, o + y = y + i * (x ** i) + enddo + endfunction interface_function + + pure function dinterface_function_dx(x, o) result(y) + !< Derivative of interface function. + real(RPP), intent(in) :: x !< X value. + integer(I_P), intent(in) :: o !< Polynomial order. + real(RPP) :: y !< Y value. + integer(I_P) :: i !< Counter. + + y = 0._RPP + do i=1, o + y = y + i * i * (x ** (i - 1)) + enddo + endfunction dinterface_function_dx +endmodule polynoms_test_module + +program polynoms_interpolation +!< WenOOF test: interpolation of polynomial functions. + +use polynoms_int_test_module + +implicit none +type(test) :: poly_test + +call poly_test%execute +endprogram polynoms_interpolation diff --git a/src/tests/polynoms_reconstruction.f90 b/src/tests/polynoms_reconstruction.f90 index b8090a4..eb74bb0 100644 --- a/src/tests/polynoms_reconstruction.f90 +++ b/src/tests/polynoms_reconstruction.f90 @@ -1,5 +1,5 @@ !< WenOOF test: reconstruction of polynomial functions. -module polynoms_test_module +module polynoms_rec_test_module !< Auxiliary module defining the test class. use flap, only : command_line_interface @@ -14,12 +14,6 @@ module polynoms_test_module implicit none private public :: test - -character(99), parameter :: interpolators(1:5) = ["all ", & - "reconstructor-JS ", & - "reconstructor-M-JS", & - "reconstructor-M-Z ", & - "reconstructor-Z "] !< List of available interpolators. real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. type :: solution_data @@ -44,22 +38,9 @@ module polynoms_test_module !< !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. private - type(command_line_interface) :: cli !< Command line interface handler. - integer(I_P) :: error=0 !< Error handler. - character(99) :: interpolator_type='JS' !< Interpolator used. - character(99) :: output_bname='unset' !< Output files basename. - character(99) :: output_dir='' !< Output directory. - integer(I_P) :: pn_number !< Number of different points-number tested. - integer(I_P), allocatable :: points_number(:) !< Points number used to discretize the domain. - integer(I_P) :: S_number !< Number of different stencils tested. - integer(I_P), allocatable :: S(:) !< Stencils used. - real(RPP) :: eps !< Smal episol to avoid zero-division. - type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. - real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. - logical :: errors_analysis=.false. !< Flag for activating errors analysis. - logical :: plots=.false. !< Flag for activating plots saving. - logical :: results=.false. !< Flag for activating results saving. - logical :: verbose=.false. !< Flag for activating verbose output. + type(test_ui) :: ui !< Command line interface handler. + type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. + real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. contains ! public methods procedure, pass(self) :: execute !< Execute selected test(s). @@ -68,7 +49,6 @@ module polynoms_test_module procedure, pass(self), private :: analize_errors !< Analize errors. procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. - procedure, pass(self), private :: initialize !< Initialize test(s). procedure, pass(self), private :: perform !< Perform test(s). procedure, pass(self), private :: save_results_and_plots !< Save results and plots. endtype test @@ -80,12 +60,11 @@ subroutine execute(self) class(test), intent(inout) :: self !< Test. integer(I_P) :: s !< Counter. - call self%initialize - if (trim(adjustl(self%interpolator_type))/='all') then + call self%ui%get + if (trim(adjustl(self%ui%interpolator_type))/='all') then call self%perform else - do s=2, size(interpolators, dim=1) - self%interpolator_type = trim(adjustl(interpolators(s))) + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) call self%perform enddo endif @@ -99,30 +78,28 @@ subroutine allocate_solution_data(self) integer(I_P) :: pn !< Counter. call self%deallocate_solution_data - self%pn_number = size(self%points_number, dim=1) - self%S_number = size(self%S, dim=1) - allocate(self%solution(1:self%pn_number, 1:self%S_number)) - if (self%pn_number>1) then - allocate(self%accuracy(1:self%pn_number, 1:self%S_number)) + allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) + if (self%ui%pn_number>1) then + allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) self%accuracy = 0._RPP endif - do s=1, self%S_number - do pn=1, self%pn_number - allocate(self%solution(pn, s)%x_cell( 1-self%S(s):self%points_number(pn)+self%S(s) )) - allocate(self%solution(pn, s)%fx_cell( 1-self%S(s):self%points_number(pn)+self%S(s) )) - allocate(self%solution(pn, s)%x_face( 1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%fx_face( 1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%dfx_cell( 1:self%points_number(pn) )) - allocate(self%solution(pn, s)%interpolation( 1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%reconstruction(1:2,1:self%points_number(pn) )) - allocate(self%solution(pn, s)%si( 1:2,1:self%points_number(pn), 0:self%S(s)-1)) - allocate(self%solution(pn, s)%weights( 1:2,1:self%points_number(pn), 0:self%S(s)-1)) + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%reconstruction( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) self%solution(pn, s)%x_cell = 0._RPP self%solution(pn, s)%fx_cell = 0._RPP self%solution(pn, s)%x_face = 0._RPP self%solution(pn, s)%fx_face = 0._RPP self%solution(pn, s)%dfx_cell = 0._RPP - self%solution(pn, s)%interpolation = 0._RPP + self%solution(pn, s)%interpolations = 0._RPP self%solution(pn, s)%reconstruction = 0._RPP self%solution(pn, s)%si = 0._RPP self%solution(pn, s)%weights = 0._RPP @@ -166,60 +143,6 @@ subroutine deallocate_solution_data(self) if (allocated(self%accuracy)) deallocate(self%accuracy) endsubroutine deallocate_solution_data - subroutine initialize(self) - !< Initialize test: set Command Line Interface, parse it and check its validity. - class(test), intent(inout) :: self !< Test. - - call set_cli - call parse_cli - contains - subroutine set_cli() - !< Set Command Line Interface. - - associate(cli => self%cli) - call cli%init(progname = 'sin reconstruction', & - authors = 'Fortran-FOSS-Programmers', & - license = 'GNU GPLv3', & - description = 'Test WenOOF library on sin function reconstruction', & - examples = ["sin_reconstruction --interpolator JS --results", & - "sin_reconstruction --interpolator JS-Z -r ", & - "sin_reconstruction --interpolator JS-M ", & - "sin_reconstruction --interpolator all -p -r "]) - call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator type', required=.false., & - def='reconstructor-JS', act='store', & - choices='all,reconstructor-JS,reconstructor-M-JS,reconstructor-M-Z,reconstructor-Z') - call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & - required=.false., act='store', def='50 100') - call cli%add(switch='--stencils', switch_ab='-s', nargs='+', help='Stencils dimensions (and number)', & - required=.false., act='store', def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') - call cli%add(switch='--eps', help='Small epsilon to avoid zero-division', required=.false., act='store', def='1.e-6') - call cli%add(switch='--output_dir', help='Output directory', required=.false., act='store', def='./') - call cli%add(switch='--results', switch_ab='-r', help='Save results', required=.false., act='store_true', def='.false.') - call cli%add(switch='--plots', switch_ab='-p', help='Save plots', required=.false., act='store_true', def='.false.') - call cli%add(switch='--output', help='Output files basename', required=.false., act='store', def='sin_reconstruction') - call cli%add(switch='--errors_analysis', help='Peform errors analysis', required=.false., act='store_true', def='.false.') - call cli%add(switch='--verbose', help='Verbose output', required=.false., act='store_true', def='.false.') - endassociate - endsubroutine set_cli - - subroutine parse_cli() - !< Parse Command Line Interface and check its validity. - character(len=:), allocatable :: valid_solvers_list !< Pretty printed list of available solvers. - - call self%cli%parse(error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(switch='-pn', val=self%points_number, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--output_dir', val=self%output_dir, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--errors_analysis', val=self%errors_analysis, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop - endsubroutine parse_cli - endsubroutine initialize - subroutine perform(self) !< Perform the test. class(test), intent(inout) :: self !< Test. @@ -419,15 +342,15 @@ pure function dinterface_function_dx(x, o) result(y) y = y + i * i * (x ** (i - 1)) enddo endfunction dinterface_function_dx -endmodule polynoms_test_module +endmodule polynoms_rec_test_module program polynoms_reconstruction !< WenOOF test: reconstruction of polynomial functions. -use polynoms_test_module +use polynoms_rec_test_module implicit none -type(test) :: sin_test +type(test) :: poly_test -call sin_test%execute +call poly_test%execute endprogram polynoms_reconstruction diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 index 953b328..b238a56 100644 --- a/src/tests/sin_interpolation.f90 +++ b/src/tests/sin_interpolation.f90 @@ -121,7 +121,7 @@ subroutine compute_reference_solution(self) self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) enddo - ! values to which the interpolation/reconstruction should tend + ! values to which the interpolation should tend do i = 1, self%ui%points_number(pn) self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP @@ -237,11 +237,11 @@ subroutine save_results_and_plots(self) write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2) L" "error (L2) R" "obs order L" "obs order R" "formal order"' do s=1, self%ui%S_number do pn=1, self%ui%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & - self%ui%points_number(pn), & - (self%solution(pn, s)%error_L2(f), f=1, 2), & - (self%accuracy(f, pn, s), f=1, 2), & - 2*self%ui%S(s)-1 + write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + (self%solution(pn, s)%error_L2(f), f=1, 2), & + (self%accuracy(f, pn, s), f=1, 2), & + 2*self%ui%S(s)-1 enddo enddo close(file_unit) @@ -256,11 +256,11 @@ subroutine save_results_and_plots(self) buffer = 'WENO interpolation of $\sin(x)$; '//& 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%fx_cell(:), & - label='$\sin(x)$', & - linestyle='k-', & - linewidth=2, & + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%fx_cell(:), & + label='$\sin(x)$', & + linestyle='k-', & + linewidth=2, & ylim=[-1.1_RPP, 1.1_RPP]) call plt%add_plot(x=self%solution(pn, s)%x_face(1,1:self%ui%points_number(pn)), & y=self%solution(pn, s)%interpolations(1,:), & From 2b035039e3c19f310b4feaf5bb2e3687d2c62a11 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 21 Feb 2017 11:41:25 +0100 Subject: [PATCH 16/90] added FOLLIA module --- .gitmodules | 4 ++++ src/third_party/FOLLIA | 1 + 2 files changed, 5 insertions(+) create mode 160000 src/third_party/FOLLIA diff --git a/.gitmodules b/.gitmodules index 038d4ca..f0fd8b5 100644 --- a/.gitmodules +++ b/.gitmodules @@ -10,3 +10,7 @@ path = src/third_party/FLAP url = https://github.com/szaghi/FLAP branch = master +[submodule "src/third_party/FOLLIA"] + path = src/third_party/FOLLIA + url = https://github.com/giacombum/FOLLIA.git + branch = master diff --git a/src/third_party/FOLLIA b/src/third_party/FOLLIA new file mode 160000 index 0000000..e16f16d --- /dev/null +++ b/src/third_party/FOLLIA @@ -0,0 +1 @@ +Subproject commit e16f16d7117085c85554a06e8252597976fd8378 From ab0d53f91db8099aa9718516fefc9e1a031870b7 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 21 Feb 2017 15:31:53 +0100 Subject: [PATCH 17/90] New test ui introduced Short description Why: * This change addresses the need by: Fix the tests in according to the new test ui introduced by @szaghi Side effects: * --- src/tests/polynoms_interpolation.f90 | 100 +++++++++--------- src/tests/polynoms_reconstruction.f90 | 141 +++++++++++++------------- src/tests/sin_interpolation.f90 | 2 +- 3 files changed, 122 insertions(+), 121 deletions(-) diff --git a/src/tests/polynoms_interpolation.f90 b/src/tests/polynoms_interpolation.f90 index 450533b..cf567a9 100644 --- a/src/tests/polynoms_interpolation.f90 +++ b/src/tests/polynoms_interpolation.f90 @@ -27,8 +27,8 @@ module polynoms_int_test_module real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: error_L2(:) !< L2 norm of the numerical error. real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). - real(RPP) :: error_L2(:) !< L2 norm of the numerical error. endtype solution_data type :: test @@ -60,8 +60,8 @@ subroutine execute(self) class(test), intent(inout) :: self !< Test. integer(I_P) :: s !< Counter. - call self%initialize - if (trim(adjustl(self%interpolator_type))/='all') then + call self%ui%get + if (trim(adjustl(self%ui%interpolator_type))/='all') then call self%perform else do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) @@ -113,20 +113,20 @@ subroutine compute_reference_solution(self) integer(I_P) :: i !< Counter. call self%allocate_solution_data - do s=1, self%S_number - do pn=1, self%pn_number - self%solution(pn, s)%Dx = 1._RPP / self%points_number(pn) + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 1._RPP / self%ui%points_number(pn) ! compute the values used for the interpolation of polynomials function: cell values - do i=1 - self%S(s), self%points_number(pn) + self%S(s) + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%S(s)+2) + self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) enddo ! values to which the interpolation should tend - do i = 1, self%points_number(pn) + do i = 1, self%ui%points_number(pn) self%solution(pn, s)%x_face( 1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP self%solution(pn, s)%x_face( 2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%S(s)+2) - self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%S(s)+2) + self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%ui%S(s)+2) + self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%ui%S(s)+2) enddo enddo enddo @@ -152,21 +152,21 @@ subroutine perform(self) integer(I_P) :: i !< Counter. call self%compute_reference_solution - do s=1, self%S_number - call wenoof_create(interpolator_type='interpolator-'trim(adjustl(self%interpolator_type)), & - S=self%S(s), & - interpolator=interpolator, & - eps=self%eps) - if (self%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%S(s):-1+self%S(s))) - do pn=1, self%pn_number - do i=1, self%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) + do s=1, self%ui%S_number + call wenoof_create(interpolator_type='interpolator-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%reconstruction(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%S(s)-1)) + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) @@ -189,26 +189,26 @@ subroutine save_results_and_plots(self) integer(I_P) :: ss !< Counter. integer(I_P) :: f !< Counter. - output_dir = trim(adjustl(self%output_dir))//'/' - if (self%results.or.self%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%output_bname))//'-'//trim(adjustl(self%interpolator_type)) + output_dir = trim(adjustl(self%ui%output_dir))//'/' + if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-'//trim(adjustl(self%ui%interpolator_type)) - if (self%results) then - do s=1, self%S_number - do pn=1, self%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%S(s), .true.))//& - '-Np_'//trim(str(self%points_number(pn), .true.))//'.dat') + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') buffer = 'VARIABLES = "x" "f(x)" "x_left" "x_right" "f(x)_left" "f(x)_right"' buffer = buffer//' "interpolation_left" "interpolation_right"' - do ss=0, self%S(s)-1 + do ss=0, self%ui%S(s)-1 buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' enddo - do ss=0, self%S(s)-1 + do ss=0, self%ui%S(s)-1 buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' enddo write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%S(s), .true.))//& - '-Np_'//trim(str(self%points_number(pn), .true.))//'"' + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' associate(x_cell => self%solution(pn, s)%x_cell, & fx_cell => self%solution(pn, s)%fx_cell, & x_face => self%solution(pn, s)%x_face, & @@ -217,26 +217,26 @@ subroutine save_results_and_plots(self) si => self%solution(pn, s)%si, & weights => self%solution(pn, s)%weights, & Dx => self%solution(pn, s)%Dx) - do i = 1, self%points_number(pn) - write(file_unit, "("//trim(str(8+4*self%S(s), .true.))//"("//FRPP//",1X))") & + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(8+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & x_cell(i), & fx_cell(i), & (x_face(f,i), f=1, 2), & (fx_face(f,i), f=1, 2), & (interpolations(f,i), f=1, 2), & - ((si(f, i, ss), f=1, 2), ss=0, self%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%S(s)-1) + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) enddo endassociate close(file_unit) enddo enddo - if (self%errors_analysis.and.self%pn_number>1) then + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then open(newunit=file_unit, file=file_bname//'-accuracy.dat') write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2) L" "error (L2) R" "obs order L" "obs order R" "formal order"' - do s=1, self%S_number - do pn=1, self%pn_number + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & self%ui%points_number(pn), & (self%solution(pn, s)%error_L2(f), f=1, 2), & @@ -251,12 +251,12 @@ subroutine save_results_and_plots(self) #ifndef r16p ! pyplot fortran does not support 128 bit reals if (self%plots) then - do s=1, self%S_number - do pn=1, self%pn_number + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number buffer = 'WENO interpolation of polynomial function; '//& - 'S='//trim(str(self%S(s), .true.))//'Np='//trim(str(self%points_number(pn), .true.)) + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%points_number(pn)), & + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & y=self%solution(pn, s)%dfx_cell(:), & label='polynom', & linestyle='k-', & @@ -275,7 +275,7 @@ subroutine save_results_and_plots(self) markersize=6, & ylim=[-1.1_RPP, 1.1_RPP]) call plt%savefig(file_bname//& - '-S_'//trim(str(self%S(s), .true.))//'-Np_'//trim(str(self%points_number(pn), .true.))//'.png') + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') enddo enddo endif @@ -346,7 +346,7 @@ pure function dinterface_function_dx(x, o) result(y) y = y + i * i * (x ** (i - 1)) enddo endfunction dinterface_function_dx -endmodule polynoms_test_module +endmodule polynoms_int_test_module program polynoms_interpolation !< WenOOF test: interpolation of polynomial functions. diff --git a/src/tests/polynoms_reconstruction.f90 b/src/tests/polynoms_reconstruction.f90 index eb74bb0..73757dd 100644 --- a/src/tests/polynoms_reconstruction.f90 +++ b/src/tests/polynoms_reconstruction.f90 @@ -10,6 +10,7 @@ module polynoms_rec_test_module #endif use pyplot_module, only : pyplot use wenoof, only : interpolator_object, wenoof_create +use wenoof_test_ui, only : test_ui implicit none private @@ -23,7 +24,7 @@ module polynoms_rec_test_module real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. - real(RPP), allocatable :: interpolation(:,:) !< Interpolated values [1:2,1:points_number]. + real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. real(RPP), allocatable :: reconstruction(:,:) !< Reconstruction values [1:2,1:points_number]. real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. @@ -91,7 +92,7 @@ subroutine allocate_solution_data(self) allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%reconstruction( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%reconstruction(1:2, 1:self%ui%points_number(pn) )) allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) self%solution(pn, s)%x_cell = 0._RPP @@ -115,21 +116,21 @@ subroutine compute_reference_solution(self) integer(I_P) :: i !< Counter. call self%allocate_solution_data - do s=1, self%S_number - do pn=1, self%pn_number - self%solution(pn, s)%Dx = 1._RPP / self%points_number(pn) + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 1._RPP / self%ui%points_number(pn) ! compute the values used for the interpolation/reconstruction of polynomials function: cell values - do i=1 - self%S(s), self%points_number(pn) + self%S(s) + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%S(s)+2) + self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) enddo ! values to which the interpolation/reconstruction should tend - do i = 1, self%points_number(pn) + do i = 1, self%ui%points_number(pn) self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%S(s)+2) - self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%S(s)+2) - self%solution(pn, s)%dfx_cell(i) = dinterface_function_dx(self%solution(pn, s)%x_cell(i), o=2*self%S(s)+2) + self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%ui%S(s)+2) + self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%ui%S(s)+2) + self%solution(pn, s)%dfx_cell(i) = dinterface_function_dx(self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) enddo enddo enddo @@ -155,21 +156,21 @@ subroutine perform(self) integer(I_P) :: i !< Counter. call self%compute_reference_solution - do s=1, self%S_number - call wenoof_create(interpolator_type=trim(adjustl(self%interpolator_type)), & - S=self%S(s), & - interpolator=interpolator, & - eps=self%eps) - if (self%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%S(s):-1+self%S(s))) - do pn=1, self%pn_number - do i=1, self%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%S(s):i-1+self%S(s)) + do s=1, self%ui%S_number + call wenoof_create(interpolator_type=trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) call interpolator%interpolate(stencil=stencil, & interpolation=self%solution(pn, s)%reconstruction(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%S(s)-1)) + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) @@ -192,26 +193,26 @@ subroutine save_results_and_plots(self) integer(I_P) :: ss !< Counter. integer(I_P) :: f !< Counter. - output_dir = trim(adjustl(self%output_dir))//'/' - if (self%results.or.self%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%output_bname))//'-'//trim(adjustl(self%interpolator_type)) + output_dir = trim(adjustl(self%ui%output_dir))//'/' + if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-'//trim(adjustl(self%ui%interpolator_type)) - if (self%results) then - do s=1, self%S_number - do pn=1, self%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%S(s), .true.))//& - '-Np_'//trim(str(self%points_number(pn), .true.))//'.dat') + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') buffer = 'VARIABLES = "x" "f(x)" "df_dx(x)" "x_left" "x_right" "f(x)_left" "f(x)_right"' buffer = buffer//' "reconstruction_left" "reconstruction_right" "df_dx_reconstruction"' - do ss=0, self%S(s)-1 + do ss=0, self%ui%S(s)-1 buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' enddo - do ss=0, self%S(s)-1 + do ss=0, self%ui%S(s)-1 buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' enddo write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%S(s), .true.))//& - '-Np_'//trim(str(self%points_number(pn), .true.))//'"' + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' associate(x_cell => self%solution(pn, s)%x_cell, & fx_cell => self%solution(pn, s)%fx_cell, & dfx_cell => self%solution(pn, s)%dfx_cell, & @@ -221,33 +222,33 @@ subroutine save_results_and_plots(self) si => self%solution(pn, s)%si, & weights => self%solution(pn, s)%weights, & Dx => self%solution(pn, s)%Dx) - do i = 1, self%points_number(pn) - write(file_unit, "("//trim(str(10+4*self%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - dfx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (reconstruction(f,i), f=1, 2), & - (reconstruction(2,i)-reconstruction(1,i))/Dx, & - ((si(f, i, ss), f=1, 2), ss=0, self%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%S(s)-1) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + dfx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (reconstruction(f,i), f=1, 2), & + (reconstruction(2,i)-reconstruction(1,i))/Dx, & + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) enddo endassociate close(file_unit) enddo enddo - if (self%errors_analysis.and.self%pn_number>1) then + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then open(newunit=file_unit, file=file_bname//'-accuracy.dat') write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' - do s=1, self%S_number - do pn=1, self%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%S(s), & - self%points_number(pn), & + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & self%solution(pn, s)%error_L2, & self%accuracy(pn, s), & - 2*self%S(s)-1 + 2*self%ui%S(s)-1 enddo enddo close(file_unit) @@ -257,18 +258,18 @@ subroutine save_results_and_plots(self) #ifndef r16p ! pyplot fortran does not support 128 bit reals if (self%plots) then - do s=1, self%S_number - do pn=1, self%pn_number + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number buffer = 'WENO reconstruction of $d \sin(x)/Dx=\cos(x)$; '//& - 'S='//trim(str(self%S(s), .true.))//'Np='//trim(str(self%points_number(pn), .true.)) + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%points_number(pn)), & - y=self%solution(pn, s)%dfx_cell(:), & - label='$\sin(x)$', & - linestyle='k-', & - linewidth=2, & + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%dfx_cell(:), & + label='$\sin(x)$', & + linestyle='k-', & + linewidth=2, & ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%points_number(pn)), & + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & y=(self%solution(pn, s)%reconstruction(2,:)-self%solution(pn, s)%reconstruction(1,:))/ & self%solution(pn, s)%Dx, & label='WENO reconstruction', & @@ -276,7 +277,7 @@ subroutine save_results_and_plots(self) markersize=6, & ylim=[-1.1_RPP, 1.1_RPP]) call plt%savefig(file_bname//& - '-S_'//trim(str(self%S(s), .true.))//'-Np_'//trim(str(self%points_number(pn), .true.))//'.png') + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') enddo enddo endif @@ -290,24 +291,24 @@ subroutine analize_errors(self) integer(I_P) :: pn !< Counter. integer(I_P) :: i !< Counter. - if (self%errors_analysis) then - do s=1, self%S_number - do pn=1, self%pn_number + if (self%ui%errors_analysis) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number associate(error_L2=>self%solution(pn, s)%error_L2, & Dx=>self%solution(pn, s)%Dx, & dfx_cell=>self%solution(pn, s)%dfx_cell, & reconstruction=>self%solution(pn, s)%reconstruction) error_L2 = 0._RPP - do i=1, self%points_number(pn) + do i=1, self%ui%points_number(pn) error_L2 = error_L2 + ((reconstruction(2,i)-reconstruction(1,i))/Dx - dfx_cell(i))**2 enddo error_L2 = sqrt(error_L2) endassociate enddo enddo - if (self%pn_number>1) then - do s=1, self%S_number - do pn=2, self%pn_number + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) enddo diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 index b238a56..9e1c519 100644 --- a/src/tests/sin_interpolation.f90 +++ b/src/tests/sin_interpolation.f90 @@ -27,8 +27,8 @@ module sin_test_module real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. - real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). real(RPP), allocatable :: error_L2(:) !< L2 norm of the numerical error [1:2]. + real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). endtype solution_data type :: test From 50d8bea8316535dfef83fc7c092bb0aca49c3419 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 22 Feb 2017 12:00:41 +0100 Subject: [PATCH 18/90] ignore venv/ folder --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index 471b059..db8e9eb 100644 --- a/.gitignore +++ b/.gitignore @@ -37,3 +37,4 @@ references/ shared/ static/ wiki/ +venv/ From 931e0959974d51686b2f0f5b4da86fc6ae9b2742 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 24 Feb 2017 19:07:16 +0100 Subject: [PATCH 19/90] Refactored reconstr and interp *NOT COMPILING* Short description Why: The interfaces of interpolator and reconstructor are different. This change addresses the need by: * Side effects: * --- .../abstract_objects/wenoof_alpha_object.F90 | 22 +- .../abstract_objects/wenoof_base_object.F90 | 21 +- .../abstract_objects/wenoof_beta_object.F90 | 19 +- .../wenoof_interpolations_object.F90 | 18 +- .../wenoof_interpolator_object.F90 | 39 +- .../abstract_objects/wenoof_kappa_object.F90 | 18 +- .../wenoof_weights_object.F90 | 32 +- .../concrete_objects/wenoof_alpha_int_js.F90 | 98 ++++ .../concrete_objects/wenoof_alpha_int_m.F90 | 137 +++++ .../concrete_objects/wenoof_alpha_int_z.F90 | 131 +++++ ...f_alpha_js.F90 => wenoof_alpha_rec_js.F90} | 29 +- ...oof_alpha_m.F90 => wenoof_alpha_rec_m.F90} | 31 +- ...oof_alpha_z.F90 => wenoof_alpha_rec_z.F90} | 29 +- .../concrete_objects/wenoof_beta_int_js.F90 | 43 +- .../concrete_objects/wenoof_beta_rec_js.F90 | 20 +- .../wenoof_interpolations_int_js.F90 | 505 +++++++++--------- .../wenoof_interpolations_rec_js.F90 | 17 +- .../wenoof_interpolator_js.F90 | 54 +- .../concrete_objects/wenoof_kappa_int_js.F90 | 199 +++---- .../concrete_objects/wenoof_kappa_rec_js.F90 | 21 +- .../wenoof_reconstructor_js.F90 | 36 +- ...ights_js.F90 => wenoof_weights_int_js.F90} | 84 +-- .../wenoof_weights_rec_js.F90 | 174 ++++++ src/lib/factories/wenoof_alpha_factory.f90 | 27 +- src/lib/factories/wenoof_beta_factory.f90 | 6 +- .../wenoof_interpolations_factory.f90 | 6 +- .../factories/wenoof_interpolator_factory.f90 | 6 +- src/lib/factories/wenoof_objects_factory.f90 | 60 +-- src/lib/factories/wenoof_weights_factory.f90 | 31 +- src/lib/wenoof.F90 | 6 +- 30 files changed, 1303 insertions(+), 616 deletions(-) create mode 100644 src/lib/concrete_objects/wenoof_alpha_int_js.F90 create mode 100644 src/lib/concrete_objects/wenoof_alpha_int_m.F90 create mode 100644 src/lib/concrete_objects/wenoof_alpha_int_z.F90 rename src/lib/concrete_objects/{wenoof_alpha_js.F90 => wenoof_alpha_rec_js.F90} (74%) rename src/lib/concrete_objects/{wenoof_alpha_m.F90 => wenoof_alpha_rec_m.F90} (81%) rename src/lib/concrete_objects/{wenoof_alpha_z.F90 => wenoof_alpha_rec_z.F90} (81%) rename src/lib/concrete_objects/{wenoof_weights_js.F90 => wenoof_weights_int_js.F90} (64%) create mode 100644 src/lib/concrete_objects/wenoof_weights_rec_js.F90 diff --git a/src/lib/abstract_objects/wenoof_alpha_object.F90 b/src/lib/abstract_objects/wenoof_alpha_object.F90 index f0f0168..1e1d2eb 100644 --- a/src/lib/abstract_objects/wenoof_alpha_object.F90 +++ b/src/lib/abstract_objects/wenoof_alpha_object.F90 @@ -23,22 +23,30 @@ module wenoof_alpha_object type, extends(base_object), abstract :: alpha_object !< Abstract alpha (non linear weights) object. - real(RPP), allocatable :: values(:,:) !< Alpha coefficients [1:2,0:S-1]. - real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. - contains - ! public deferred methods - procedure(compute_interface), pass(self), deferred :: compute !< Compute alpha. + ! public methods + generic :: compute => compute_alpha_int, compute_alpha_rec + ! deferred public methods + procedure(compute_alpha_int_interface), pass(self), deferred :: compute_alpha_int!< Compute beta. + procedure(compute_alpha_rec_interface), pass(self), deferred :: compute_alpha_rec!< Compute beta. endtype alpha_object abstract interface !< Abstract interfaces of [[alpha_object]]. - pure subroutine compute_interface(self, beta, kappa) + pure subroutine compute_alpha_int_interface(self, beta, kappa) + !< Compute alpha. + import :: alpha_object, beta_object, kappa_object + class(alpha_object), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + endsubroutine compute_alpha_int_interface + + pure subroutine compute_alpha_rec_interface(self, beta, kappa) !< Compute alpha. import :: alpha_object, beta_object, kappa_object class(alpha_object), intent(inout) :: self !< Alpha. class(beta_object), intent(in) :: beta !< Beta. class(kappa_object), intent(in) :: kappa !< Kappa. - endsubroutine compute_interface + endsubroutine compute_alpha_rec_interface endinterface endmodule wenoof_alpha_object diff --git a/src/lib/abstract_objects/wenoof_base_object.F90 b/src/lib/abstract_objects/wenoof_base_object.F90 index 044f11c..50cbf9a 100644 --- a/src/lib/abstract_objects/wenoof_base_object.F90 +++ b/src/lib/abstract_objects/wenoof_base_object.F90 @@ -20,8 +20,6 @@ module wenoof_base_object type, abstract :: base_object_constructor !< Abstract base object constructor. integer(I_P) :: S=0_I_P !< Stencils dimension. - logical :: face_left=.true. !< Activate left-face interpolation computation. - logical :: face_right=.true. !< Activate right-face interpolation computation. real(RPP) :: eps=EPS_DEF !< Small epsilon to avoid division by zero. contains procedure, pass(self) :: create => create_base_object_constructor @@ -32,9 +30,6 @@ module wenoof_base_object !< !< Define a minimal, base, object that is used as ancestor of all objects, e.g. smoothness indicator, optimal weights, etc... integer(I_P) :: S=0_I_P !< Stencils dimension. - integer(I_P) :: f1=1_I_P !< Lower bound of faces index. - integer(I_P) :: f2=2_I_P !< Upper bound of faces index. - integer(I_P) :: ff=0_I_P !< Offset (step) of faces index. real(RPP) :: eps=EPS_DEF !< Small epsilon to avoid division by zero. contains ! public deferred methods @@ -75,17 +70,13 @@ elemental subroutine destroy_interface(self) ! base object constructor ! public methods - subroutine create_base_object_constructor(self, S, face_left, face_right, eps) + subroutine create_base_object_constructor(self, S, eps) !< Create alpha constructor. class(base_object_constructor), intent(inout) :: self !< Constructor. integer(I_P), intent(in) :: S !< Stencils dimension. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. real(RPP), intent(in), optional :: eps !< Small epsilon to avoid division by zero. self%S = S - if (present(face_left)) self%face_left = face_left - if (present(face_right)) self%face_right = face_right if (present(eps)) self%eps = eps endsubroutine create_base_object_constructor @@ -101,13 +92,6 @@ subroutine create_(self, constructor) select type(constructor) class is(base_object_constructor) self%S = constructor%S - if (constructor%face_left.and.constructor%face_right) then - self%f1 = 1_I_P; self%f2 = 2_I_P; self%ff = 0_I_P - elseif (constructor%face_left) then - self%f1 = 1_I_P; self%f2 = 1_I_P; self%ff = 0_I_P - elseif (constructor%face_right) then - self%f1 = 2_I_P; self%f2 = 2_I_P; self%ff = -1_I_P - endif self%eps = constructor%eps endselect endsubroutine create_ @@ -117,9 +101,6 @@ elemental subroutine destroy_(self) class(base_object), intent(inout) :: self !< Object. self%S = 0_I_P - self%f1 = 1_I_P - self%f2 = 2_I_P - self%ff = 0_I_P self%eps = EPS_DEF endsubroutine destroy_ endmodule wenoof_base_object diff --git a/src/lib/abstract_objects/wenoof_beta_object.F90 b/src/lib/abstract_objects/wenoof_beta_object.F90 index 1711c3b..ccc000c 100644 --- a/src/lib/abstract_objects/wenoof_beta_object.F90 +++ b/src/lib/abstract_objects/wenoof_beta_object.F90 @@ -20,20 +20,29 @@ module wenoof_beta_object type, extends(base_object), abstract :: beta_object !< Abstract Beta coefficients (smoothness indicators of stencil interpolations) object. - real(RPP), allocatable :: values(:,:) !< Beta values [1:2,0:S-1]. contains - ! public deferred methods - procedure(compute_interface), pass(self), deferred :: compute !< Compute beta. + ! public methods + generic :: compute => compute_with_stencil_of_rank_1, compute_with_stencil_of_rank_2 + ! deferred public methods + procedure(compute_with_stencil_of_rank_1_interface), pass(self), deferred :: compute_with_stencil_of_rank_1!< Compute beta. + procedure(compute_with_stencil_of_rank_2_interface), pass(self), deferred :: compute_with_stencil_of_rank_2!< Compute beta. endtype beta_object abstract interface !< Abstract interfaces of [[beta_object]]. - pure subroutine compute_interface(self, stencil) + pure subroutine compute_with_stencil_of_rank_1_interface(self, stencil) + !< Compute beta. + import :: beta_object, RPP + class(beta_object), intent(inout) :: self !< Beta. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + endsubroutine compute_with_stencil_of_rank_1_interface + + pure subroutine compute_with_stencil_of_rank_2_interface(self, stencil) !< Compute beta. import :: beta_object, RPP class(beta_object), intent(inout) :: self !< Beta. real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - endsubroutine compute_interface + endsubroutine compute_with_stencil_of_rank_2_interface endinterface endmodule wenoof_beta_object diff --git a/src/lib/abstract_objects/wenoof_interpolations_object.F90 b/src/lib/abstract_objects/wenoof_interpolations_object.F90 index 599622c..2ad5935 100644 --- a/src/lib/abstract_objects/wenoof_interpolations_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolations_object.F90 @@ -22,18 +22,28 @@ module wenoof_interpolations_object !< Abstract interpolations object. real(RPP), allocatable :: values(:,:) !< Stencil interpolations values [1:2,0:S-1]. contains - ! public deferred methods - procedure(compute_interface), pass(self), deferred :: compute !< Compute beta. + ! public methods + generic :: compute => compute_with_stencil_of_rank_1, compute_with_stencil_of_rank_2 + ! deferred public methods + procedure(compute_with_stencil_of_rank_1_interface), pass(self), deferred :: compute_with_stencil_of_rank_1!< Compute interp. + procedure(compute_with_stencil_of_rank_2_interface), pass(self), deferred :: compute_with_stencil_of_rank_2!< Compute interp. endtype interpolations_object abstract interface !< Abstract interfaces of [[interpolations_object]]. - pure subroutine compute_interface(self, stencil) + pure subroutine compute_with_stencil_of_rank_1_interface(self, stencil) + !< Compute interpolations. + import :: interpolations_object, RPP + class(interpolations_object), intent(inout) :: self !< Interpolations. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + endsubroutine compute_with_stencil_of_rank_1_interface + + pure subroutine compute_with_stencil_of_rank_2_interface(self, stencil) !< Compute interpolations. import :: interpolations_object, RPP class(interpolations_object), intent(inout) :: self !< Interpolations. real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - endsubroutine compute_interface + endsubroutine compute_with_stencil_of_rank_2_interface endinterface endmodule wenoof_interpolations_object diff --git a/src/lib/abstract_objects/wenoof_interpolator_object.F90 b/src/lib/abstract_objects/wenoof_interpolator_object.F90 index 45cf577..75c851e 100644 --- a/src/lib/abstract_objects/wenoof_interpolator_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolator_object.F90 @@ -31,16 +31,35 @@ module wenoof_interpolator_object class(interpolations_object), allocatable :: interpolations !< Stencil interpolations. class(weights_object), allocatable :: weights !< Weights of interpolations. contains + ! public methods + generic :: interpolate_debug => interpolate_with_stencil_of_rank_1_debug, interpolate_with_stencil_of_rank_2_debug + generic :: interpolate_standard => interpolate_with_stencil_of_rank_1_standard, interpolate_with_stencil_of_rank_2_standard ! public deferred methods - procedure(interpolate_debug_interface), pass(self), deferred :: interpolate_debug !< Interpolate values, debug mode. - procedure(interpolate_standard_interface), pass(self), deferred :: interpolate_standard !< Interpolate values, standard mode. + procedure(interpolate_with_stencil_of_rank_1_debug_interface), pass(self), & + deferred :: interpolate_with_stencil_of_rank_1_debug + procedure(interpolate_with_stencil_of_rank_2_debug_interface), pass(self), & + deferred :: interpolate_with_stencil_of_rank_2_debug + procedure(interpolate_with_stencil_of_rank_1_standard_interface), pass(self), & + deferred :: interpolate_with_stencil_of_rank_1_standard + procedure(interpolate_with_stencil_of_rank_2_standard_interface), pass(self), & + deferred :: interpolate_with_stencil_of_rank_2_standard ! public methods generic :: interpolate => interpolate_standard, interpolate_debug !< Interpolate values. endtype interpolator_object abstract interface !< Abstract interfaces of [[interpolator_object]]. - pure subroutine interpolate_debug_interface(self, stencil, interpolation, si, weights) + pure subroutine interpolate_with_stencil_of_rank_1_debug_interface(self, stencil, interpolation, si, weights) + !< Interpolate values (providing also debug values). + import :: interpolator_object, RPP + class(interpolator_object), intent(inout) :: self !< Interpolator. + real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1-S:-1+S]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation. + real(RPP), intent(out) :: si(0:) !< Computed values of smoothness indicators [0:S-1]. + real(RPP), intent(out) :: weights(0:) !< Weights of the stencils, [0:S-1]. + endsubroutine interpolate_with_stencil_of_rank_1_debug_interface + + pure subroutine interpolate_with_stencil_of_rank_2_debug_interface(self, stencil, interpolation, si, weights) !< Interpolate values (providing also debug values). import :: interpolator_object, RPP class(interpolator_object), intent(inout) :: self !< Interpolator. @@ -48,15 +67,23 @@ pure subroutine interpolate_debug_interface(self, stencil, interpolation, si, we real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. real(RPP), intent(out) :: si(1:, 0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. real(RPP), intent(out) :: weights(1:, 0:) !< Weights of the stencils, [1:2, 0:S-1]. - endsubroutine interpolate_debug_interface + endsubroutine interpolate_with_stencil_of_rank_2_debug_interface + + pure subroutine interpolate_with_stencil_of_rank_1_standard_interface(self, stencil, interpolation) + !< Interpolate values (without providing debug values). + import :: interpolator_object, RPP + class(interpolator_object), intent(inout) :: self !< Interpolator. + real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1-S:-1+S]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation. + endsubroutine interpolate_with_stencil_of_rank_1_standard_interface - pure subroutine interpolate_standard_interface(self, stencil, interpolation) + pure subroutine interpolate_with_stencil_of_rank_2_standard_interface(self, stencil, interpolation) !< Interpolate values (without providing debug values). import :: interpolator_object, RPP class(interpolator_object), intent(inout) :: self !< Interpolator. real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. - endsubroutine interpolate_standard_interface + endsubroutine interpolate_with_stencil_of_rank_2_standard_interface endinterface endmodule wenoof_interpolator_object diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index c50bc83..3742401 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -20,19 +20,27 @@ module wenoof_kappa_object type, extends(base_object), abstract :: kappa_object !< Kappa (optimal, linear weights of stencil interpolations) object. - real(RPP), allocatable :: values(:,:) !< Kappa coefficients values [1:2,0:S-1]. contains - ! public deferred methods - procedure(compute_interface), pass(self), deferred :: compute !< Compute kappa. + ! public methods + generic :: compute => compute_kappa_int, compute_kappa_rec + ! deferred public methods + procedure(compute_kappa_int_interface), pass(self), deferred :: compute_kappa_int!< Compute beta. + procedure(compute_kappa_rec_interface), pass(self), deferred :: compute_kappa_rec!< Compute beta. endtype kappa_object abstract interface !< Abstract interfaces of [[kappa_object]]. - pure subroutine compute_interface(self) + pure subroutine compute_kappa_int_interface(self) !< Compute kappa. import :: kappa_object class(kappa_object), intent(inout) :: self !< Kappa. - endsubroutine compute_interface + endsubroutine compute_kappa_int_interface + + pure subroutine compute_kappa_rec_interface(self) + !< Compute kappa. + import :: kappa_object + class(kappa_object), intent(inout) :: self !< Kappa. + endsubroutine compute_kappa_rec_interface endinterface endmodule wenoof_kappa_object diff --git a/src/lib/abstract_objects/wenoof_weights_object.F90 b/src/lib/abstract_objects/wenoof_weights_object.F90 index 3c6afc1..32c7cec 100644 --- a/src/lib/abstract_objects/wenoof_weights_object.F90 +++ b/src/lib/abstract_objects/wenoof_weights_object.F90 @@ -20,28 +20,46 @@ module wenoof_weights_object type, extends(base_object), abstract :: weights_object !< Weights of stencil interpolations object. - real(RPP), allocatable :: values(:,:) !< Weights values of stencil interpolations [1:2,0:S-1]. contains + ! public methods + generic :: compute => compute_with_stencil_of_rank_1, compute_with_stencil_of_rank_2 + generic :: smoothness_indicators => smoothness_indicators_of_rank_1, smoothness_indicators_of_rank_2 ! deferred public methods - procedure(compute_interface), pass(self), deferred :: compute !< Compute weights. - procedure(smoothness_indicators_interface), pass(self), deferred :: smoothness_indicators !< Return smoothness indicators. + procedure(compute_with_stencil_of_rank_1_interface), pass(self), deferred :: compute_with_stencil_of_rank_1 !< Compute beta. + procedure(compute_with_stencil_of_rank_2_interface), pass(self), deferred :: compute_with_stencil_of_rank_2 !< Compute beta. + procedure(smoothness_indicators_of_rank_1_interface), pass(self), deferred :: smoothness_indicators_of_rank_1 !< Return IS. + procedure(smoothness_indicators_of_rank_2_interface), pass(self), deferred :: smoothness_indicators_of_rank_2 !< Return IS. endtype weights_object abstract interface !< Abstract interfaces of [[weights_object]]. - pure subroutine compute_interface(self, stencil) + pure subroutine compute_with_stencil_of_rank_1_interface(self, stencil) + !< Compute beta. + import :: weights_object, RPP + class(weights_object), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + endsubroutine compute_with_stencil_of_rank_1_interface + + pure subroutine compute_with_stencil_of_rank_2_interface(self, stencil) !< Compute beta. import :: weights_object, RPP class(weights_object), intent(inout) :: self !< Weights. real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - endsubroutine compute_interface + endsubroutine compute_with_stencil_of_rank_2_interface + + pure function smoothness_indicators_of_rank_1_interface(self) result(si) + !< Return smoothness indicators. + import :: weights_object, RPP + class(weights_object), intent(in) :: self !< Weights. + real(RPP), allocatable :: si(:) !< Smoothness indicators. + endfunction smoothness_indicators_of_rank_1_interface - pure function smoothness_indicators_interface(self) result(si) + pure function smoothness_indicators_of_rank_2_interface(self) result(si) !< Return smoothness indicators. import :: weights_object, RPP class(weights_object), intent(in) :: self !< Weights. real(RPP), allocatable :: si(:,:) !< Smoothness indicators. - endfunction smoothness_indicators_interface + endfunction smoothness_indicators_of_rank_2_interface endinterface endmodule wenoof_weights_object diff --git a/src/lib/concrete_objects/wenoof_alpha_int_js.F90 b/src/lib/concrete_objects/wenoof_alpha_int_js.F90 new file mode 100644 index 0000000..29aeacb --- /dev/null +++ b/src/lib/concrete_objects/wenoof_alpha_int_js.F90 @@ -0,0 +1,98 @@ +!< Jiang-Shu alpha (non linear weights) object. +module wenoof_alpha_int_js +!< Jiang-Shu alpha (non linear weights) object. +!< +!< @note The provided alpha implements the alpha coefficients defined in *Efficient Implementation of Weighted ENO +!< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130. + +#ifdef r16p +use penf, only: I_P, RPP=>R16P, str +#else +use penf, only: I_P, RPP=>R8P, str +#endif +use wenoof_alpha_object +use wenoof_base_object +use wenoof_beta_object +use wenoof_kappa_object + +implicit none +private +public :: alpha_int_js +public :: alpha_int_js_constructor + +type, extends(alpha_object_constructor) :: alpha_int_js_constructor + !< Jiang-Shu alpha object constructor. +endtype alpha_int_js_constructor + +type, extends(alpha_object) :: alpha_int_js + !< Jiang-Shu alpha object. + !< + !< @note The provided WENO alpha implements the alpha coefficients defined in *Efficient Implementation of Weighted + !< ENO Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130. + real(RPP), allocatable :: values(:) !< Alpha coefficients [0:S-1]. + real(RPP) :: values_sum !< Sum of alpha coefficients. + contains + ! public deferred methods + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute_alpha_int !< Compute alpha. + procedure, pass(self) :: compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. +endtype alpha_int_js + +contains + ! deferred public methods + subroutine create(self, constructor) + !< Create alpha. + class(alpha_int_js), intent(inout) :: self !< Alpha. + class(base_object_constructor), intent(in) :: constructor !< Alpha constructor. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(0:self%S - 1)) + self%values = 0._RPP + self%values_sum = 0._RPP + endsubroutine create + + pure subroutine compute_alpha_int(self, beta, kappa) + !< Compute alpha. + class(alpha_int_js), intent(inout) :: self !< Alpha coefficient. + class(beta_object), intent(in) :: beta !< Beta coefficients. + class(kappa_object), intent(in) :: kappa !< Kappa coefficients. + integer(I_P) :: s1 !< Counter. + + self%values_sum = 0._RPP + do s1=0, self%S - 1 ! stencil loops + self%values(s1) = kappa%values(s1)/(self%eps + beta%values(s1)) ** self%S + self%values_sum = self%values_sum + self%values(s1) + enddo + endsubroutine compute_alpha_int + + pure subroutine compute_alpha_rec(self, beta, kappa) + !< Compute alpha. + class(alpha_int_js), intent(inout) :: self !< Alpha coefficient. + class(beta_object), intent(in) :: beta !< Beta coefficients. + class(kappa_object), intent(in) :: kappa !< Kappa coefficients. + + ! Empty subroutine + endsubroutine compute_alpha_rec + + pure function description(self) result(string) + !< Return alpha string-descripition. + class(alpha_int_js), intent(in) :: self !< Alpha coefficient. + character(len=:), allocatable :: string !< String-description. + character(len=1), parameter :: nl=new_line('a') !< New line char. + + string = ' Jiang-Shu alpha coefficients for reconstructor:'//nl + string = string//' - S = '//trim(str(self%S))//nl + string = string//' - eps = '//trim(str(self%eps)) + endfunction description + + elemental subroutine destroy(self) + !< Destroy alpha. + class(alpha_int_js), intent(inout) :: self !< Alpha. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + endsubroutine destroy +endmodule wenoof_alpha_int_js diff --git a/src/lib/concrete_objects/wenoof_alpha_int_m.F90 b/src/lib/concrete_objects/wenoof_alpha_int_m.F90 new file mode 100644 index 0000000..d3897ed --- /dev/null +++ b/src/lib/concrete_objects/wenoof_alpha_int_m.F90 @@ -0,0 +1,137 @@ +!< Henrick alpha (non linear weights) object. +module wenoof_alpha_int_m +!< Henrick alpha (non linear weights) object. +!< +!< @note The provided alpha implements the alpha coefficients defined in *Mapped weighted essentially non-oscillatory schemes: +!< Achieving optimal order near critical points*, Andrew K. Henrick, Tariq D. Aslam, Joseph M. Powers, JCP, +!< 2005, vol. 207, pp. 542-567, doi:10.1016/j.jcp.2005.01.023 + +#ifdef r16p +use penf, only: I_P, RPP=>R16P, str +#else +use penf, only: I_P, RPP=>R8P, str +#endif +use wenoof_alpha_object +use wenoof_alpha_rec_js +use wenoof_alpha_rec_z +use wenoof_base_object +use wenoof_beta_object +use wenoof_kappa_object + +implicit none +private +public :: alpha_int_m +public :: alpha_int_m_constructor + +type, extends(alpha_object_constructor) :: alpha_int_m_constructor + !< Henrick alpha (non linear weights) object constructor. + character(len=:), allocatable :: base_type !< Base alpha coefficient type. +endtype alpha_int_m_constructor + +type, extends(alpha_object) :: alpha_int_m + !< Henrick alpha (non linear weights) object. + !< + !< @note The provided alpha implements the alpha coefficients defined in *Mapped weighted essentially non-oscillatory schemes: + !< Achieving optimal order near critical points*, Andrew K. Henrick, Tariq D. Aslam, Joseph M. Powers, + !< JCP, 2005, vol. 207, pp. 542-567, doi:10.1016/j.jcp.2005.01.023. + real(RPP), allocatable :: values(:) !< Alpha coefficients [0:S-1]. + real(RPP) :: values_sum !< Sum of alpha coefficients. + class(alpha_object), allocatable :: alpha_base !< Base alpha to be re-mapped. + contains + ! public deferred methods + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute_alpha_int !< Compute alpha. + procedure, pass(self) :: compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. +endtype alpha_int_m + +contains + ! deferred public methods + subroutine create(self, constructor) + !< Create alpha. + class(alpha_int_m), intent(inout) :: self !< Alpha. + class(base_object_constructor), intent(in) :: constructor !< Alpha constructor. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(0:self%S - 1)) + self%values = 0._RPP + self%values_sum = 0._RPP + select type(constructor) + type is(alpha_int_m_constructor) + if (allocated(constructor%base_type)) then + select case(constructor%base_type) + case('JS') + if (allocated(self%alpha_base)) deallocate(self%alpha_base) + allocate(alpha_rec_js :: self%alpha_base) + call self%alpha_base%create(constructor=constructor) + case('Z') + if (allocated(self%alpha_base)) deallocate(self%alpha_base) + allocate(alpha_rec_z :: self%alpha_base) + call self%alpha_base%create(constructor=constructor) + endselect + endif + class default + ! @TODO add error handling + endselect + endsubroutine create + + pure subroutine compute_alpha_int(self, beta, kappa) + !< Compute alpha. + class(alpha_int_m), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + real(RPP) :: kappa_base !< Kappa evaluated from the base alphas. + integer(I_P) :: s1 !< Counter. + + self%values_sum = 0._RPP + call self%alpha_base%compute(beta=beta, kappa=kappa) + do s1=0, self%S - 1 ! stencil loops + kappa_base = self%alpha_base%values(s1) / self%alpha_base%values_sum + self%values(s1) = & + (kappa_base * (kappa%values(s1) + kappa%values(s1) * kappa%values(s1) - & + 3._RPP * kappa%values(s1) * kappa_base + kappa_base * kappa_base)) / & + (kappa%values(s1) * kappa%values(s1) + kappa_base * & + (1._RPP - 2._RPP * kappa%values(s1))) + self%values_sum = self%values_sum + self%values(s1) + enddo + endsubroutine compute_alpha_int + + pure subroutine compute_alpha_rec(self, beta, kappa) + !< Compute alpha. + class(alpha_int_m), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + + ! Empty subroutine. + endsubroutine compute_alpha_rec + + pure function description(self) result(string) + !< Return alpha string-descripition. + class(alpha_int_m), intent(in) :: self !< Alpha. + character(len=:), allocatable :: string !< String-description. + character(len=1), parameter :: nl=new_line('a') !< New line char. + + string = ' Henrick alpha coefficients for reconstructor:'//nl + string = string//' - S = '//trim(str(self%S))//nl + string = string//' - eps = '//trim(str(self%eps))//nl + associate(alpha_base=>self%alpha_base) + select type(alpha_base) + type is(alpha_rec_js) + string = string//' - base-mapped-alpha type = Jiang-Shu' + type is(alpha_rec_z) + string = string//' - base-mapped-alpha type = Bogeg' + endselect + endassociate + endfunction description + + elemental subroutine destroy(self) + !< Destroy alpha. + class(alpha_int_m), intent(inout) :: self !< Alpha. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + if (allocated(self%alpha_base)) deallocate(self%alpha_base) + endsubroutine destroy +endmodule wenoof_alpha_int_m diff --git a/src/lib/concrete_objects/wenoof_alpha_int_z.F90 b/src/lib/concrete_objects/wenoof_alpha_int_z.F90 new file mode 100644 index 0000000..f10d906 --- /dev/null +++ b/src/lib/concrete_objects/wenoof_alpha_int_z.F90 @@ -0,0 +1,131 @@ +!< Borges alpha (non linear weights) object. +module wenoof_alpha_int_z +!< Borges alpha (non linear weights) object. +!< +!< @note The provided WENO alpha implements the alpha coefficients defined in *An improved weighted essentially non-oscillatory +!< scheme for hyperbolic conservation laws*, Rafael Borges, Monique Carmona, Bruno Costa and Wai Sun Don, JCP, 2008, +!< vol. 227, pp. 3191-3211, doi: 10.1016/j.jcp.2007.11.038. + +#ifdef r16p +use penf, only: I_P, RPP=>R16P, str +#else +use penf, only: I_P, RPP=>R8P, str +#endif +use wenoof_alpha_object +use wenoof_base_object +use wenoof_beta_object +use wenoof_kappa_object + +implicit none +private +public :: alpha_int_z +public :: alpha_int_z_constructor + +type, extends(alpha_object_constructor) :: alpha_int_z_constructor + !< Borges alpha (non linear weights) object constructor. +endtype alpha_int_z_constructor + +type, extends(alpha_object) :: alpha_int_z + !< Borges alpha (non linear weights) object. + !< + !< @note The provided alpha implements the alpha coefficients defined in *An improved weighted essentially non-oscillatory + !< scheme for hyperbolic conservation laws*, Rafael Borges, Monique Carmona, Bruno Costa and Wai Sun Don, JCP, + !< 2008, vol. 227, pp. 3191-3211, doi: 10.1016/j.jcp.2007.11.038. + real(RPP), allocatable :: values(:) !< Alpha coefficients [0:S-1]. + real(RPP), :: values_sum !< Sum of alpha coefficients. + contains + ! public deferred methods + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute_alpha_int !< Compute alpha. + procedure, pass(self) :: compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. + enddo +endtype alpha_int_z +contains + ! public deferred methods + subroutine create(self, constructor) + !< Create alpha. + class(alpha_int_z), intent(inout) :: self !< Alpha. + class(base_object_constructor), intent(in) :: constructor !< Alpha constructor. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(0:self%S - 1)) + self%values = 0._RPP + self%values_sum = 0._RPP + endsubroutine create + + pure subroutine compute_alpha_int(self, beta, kappa) + !< Compute alpha. + class(alpha_int_z), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + integer(I_P) :: s1 !< Counter. + + self%values_sum = 0._RPP + do s1=0, self%S - 1 ! stencil loops + self%values(s1) = kappa%values(s1) * & + ((1._RPP + (tau(S=self%S, beta=beta%values) / (self%eps + beta%values(s1)))) ** (weno_exp(self%S))) + self%values_sum = self%values_sum + self%values(s1) + enddo + endsubroutine compute_alpha_int + + pure subroutine compute_alpha_rec(self, beta, kappa) + !< Compute alpha. + class(alpha_int_z), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + + ! Empty subroutine. + endsubroutine compute_alpha_rec + + pure function description(self) result(string) + !< Return alpha string-descripition. + class(alpha_int_z), intent(in) :: self !< Alpha coefficients. + character(len=:), allocatable :: string !< String-description. + character(len=1), parameter :: nl=new_line('a') !< New line char. + + string = ' Borges alpha coefficients for reconstructor:'//nl + string = string//' - S = '//trim(str(self%S))//nl + string = string//' - eps = '//trim(str(self%eps)) + + endfunction description + + elemental subroutine destroy(self) + !< Destroy alpha. + class(alpha_int_z), intent(inout) :: self !< Alpha. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + endsubroutine destroy + + ! private non TBP + pure function tau(S, beta) result(w_tau) + !< Compute the tau coefficient used in the WENO-Z alpha coefficients. + integer(I_P), intent(in) :: S !< Number of stencils used. + real(RPP), intent(in) :: beta(0:S-1) !< Smoothness indicators. + real(RPP) :: w_tau !< Tau coefficient. + + w_tau = abs(beta(0) - & + (1_I_P - weno_odd(S)) * beta(1) - & + (1_I_P - weno_odd(S)) * beta(S-2) + & + (1_I_P - 2_I_P * weno_odd(S)) * beta(S-1)) + endfunction tau + + pure function weno_exp(S) result(w_exp) + !< Compute the exponent used in the alpha function. + integer(I_P), intent(in) :: S !< Number of stencils used. + integer(I_P) :: w_exp !< Exponent used in the alpha function. + + w_exp = int(S, I_P) + endfunction weno_exp + + pure function weno_odd(S) result(w_odd) + !< Compute the distinguisher between odd and even number of stencils. + integer(I_P), intent(in) :: S !< Number of stencils used. + integer(I_P) :: w_odd !< Distinguishing between odd and even number of stencils. + + w_odd = int(mod(S, 2_I_P), I_P) + endfunction weno_odd +endmodule wenoof_alpha_int_z diff --git a/src/lib/concrete_objects/wenoof_alpha_js.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 similarity index 74% rename from src/lib/concrete_objects/wenoof_alpha_js.F90 rename to src/lib/concrete_objects/wenoof_alpha_rec_js.F90 index 89b3c21..7000bfb 100644 --- a/src/lib/concrete_objects/wenoof_alpha_js.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 @@ -29,12 +29,15 @@ module wenoof_alpha_rec_js !< !< @note The provided WENO alpha implements the alpha coefficients defined in *Efficient Implementation of Weighted !< ENO Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130. + real(RPP), allocatable :: values(:,:) !< Alpha coefficients [1:2,0:S-1]. + real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute_alpha_int !< Compute alpha. + procedure, pass(self) :: compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_rec_js contains @@ -52,7 +55,16 @@ subroutine create(self, constructor) self%values_sum = 0._RPP endsubroutine create - pure subroutine compute(self, beta, kappa) + pure subroutine compute_alpha_int(self, beta, kappa) + !< Compute alpha. + class(alpha_rec_js), intent(inout) :: self !< Alpha coefficient. + class(beta_object), intent(in) :: beta !< Beta coefficients. + class(kappa_object), intent(in) :: kappa !< Kappa coefficients. + + ! Empty subroutine. + endsubroutine compute_alpha_int + + pure subroutine compute_alpha_rec(self, beta, kappa) !< Compute alpha. class(alpha_rec_js), intent(inout) :: self !< Alpha coefficient. class(beta_object), intent(in) :: beta !< Beta coefficients. @@ -61,12 +73,12 @@ pure subroutine compute(self, beta, kappa) self%values_sum = 0._RPP do s1=0, self%S - 1 ! stencil loops - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) self%values(f, s1) = kappa%values(f, s1)/(self%eps + beta%values(f, s1)) ** self%S self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo enddo - endsubroutine compute + endsubroutine compute_alpha_rec pure function description(self) result(string) !< Return alpha string-descripition. @@ -76,9 +88,6 @@ pure function description(self) result(string) string = ' Jiang-Shu alpha coefficients for reconstructor:'//nl string = string//' - S = '//trim(str(self%S))//nl - string = string//' - f1 = '//trim(str(self%f1))//nl - string = string//' - f2 = '//trim(str(self%f2))//nl - string = string//' - ff = '//trim(str(self%ff))//nl string = string//' - eps = '//trim(str(self%eps)) endfunction description diff --git a/src/lib/concrete_objects/wenoof_alpha_m.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 similarity index 81% rename from src/lib/concrete_objects/wenoof_alpha_m.F90 rename to src/lib/concrete_objects/wenoof_alpha_rec_m.F90 index 289a9a1..963953a 100644 --- a/src/lib/concrete_objects/wenoof_alpha_m.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 @@ -34,13 +34,16 @@ module wenoof_alpha_rec_m !< @note The provided alpha implements the alpha coefficients defined in *Mapped weighted essentially non-oscillatory schemes: !< Achieving optimal order near critical points*, Andrew K. Henrick, Tariq D. Aslam, Joseph M. Powers, !< JCP, 2005, vol. 207, pp. 542-567, doi:10.1016/j.jcp.2005.01.023. - class(alpha_object), allocatable :: alpha_base !< Base alpha to be re-mapped. + real(RPP), allocatable :: values(:,:) !< Alpha coefficients [1:2,0:S-1]. + real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. + class(alpha_object), allocatable :: alpha_base !< Base alpha to be re-mapped. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute_alpha_int !< Compute alpha. + procedure, pass(self) :: compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_rec_m contains @@ -75,7 +78,16 @@ subroutine create(self, constructor) endselect endsubroutine create - pure subroutine compute(self, beta, kappa) + pure subroutine compute_alpha_int(self, beta, kappa) + !< Compute alpha. + class(alpha_rec_m), intent(inout) :: self !< Alpha coefficient. + class(beta_object), intent(in) :: beta !< Beta coefficients. + class(kappa_object), intent(in) :: kappa !< Kappa coefficients. + + ! Empty subroutine. + endsubroutine compute_alpha_int + + pure subroutine compute_alpha_rec(self, beta, kappa) !< Compute alpha. class(alpha_rec_m), intent(inout) :: self !< Alpha. class(beta_object), intent(in) :: beta !< Beta. @@ -86,7 +98,7 @@ pure subroutine compute(self, beta, kappa) self%values_sum = 0._RPP call self%alpha_base%compute(beta=beta, kappa=kappa) do s1=0, self%S - 1 ! stencil loops - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) kappa_base = self%alpha_base%values(f, s1) / self%alpha_base%values_sum(f) self%values(f, s1) = & (kappa_base * (kappa%values(f, s1) + kappa%values(f, s1) * kappa%values(f, s1) - & @@ -97,7 +109,7 @@ pure subroutine compute(self, beta, kappa) self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo enddo - endsubroutine compute + endsubroutine compute_alpha_rec pure function description(self) result(string) !< Return alpha string-descripition. @@ -107,9 +119,6 @@ pure function description(self) result(string) string = ' Henrick alpha coefficients for reconstructor:'//nl string = string//' - S = '//trim(str(self%S))//nl - string = string//' - f1 = '//trim(str(self%f1))//nl - string = string//' - f2 = '//trim(str(self%f2))//nl - string = string//' - ff = '//trim(str(self%ff))//nl string = string//' - eps = '//trim(str(self%eps))//nl associate(alpha_base=>self%alpha_base) select type(alpha_base) diff --git a/src/lib/concrete_objects/wenoof_alpha_z.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 similarity index 81% rename from src/lib/concrete_objects/wenoof_alpha_z.F90 rename to src/lib/concrete_objects/wenoof_alpha_rec_z.F90 index 017d78d..f9f75be 100644 --- a/src/lib/concrete_objects/wenoof_alpha_z.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 @@ -31,12 +31,15 @@ module wenoof_alpha_rec_z !< @note The provided alpha implements the alpha coefficients defined in *An improved weighted essentially non-oscillatory !< scheme for hyperbolic conservation laws*, Rafael Borges, Monique Carmona, Bruno Costa and Wai Sun Don, JCP, !< 2008, vol. 227, pp. 3191-3211, doi: 10.1016/j.jcp.2007.11.038. + real(RPP), allocatable :: values(:,:) !< Alpha coefficients [1:2,0:S-1]. + real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute_alpha_int !< Compute alpha. + procedure, pass(self) :: compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_rec_z contains ! public deferred methods @@ -53,7 +56,16 @@ subroutine create(self, constructor) self%values_sum = 0._RPP endsubroutine create - pure subroutine compute(self, beta, kappa) + pure subroutine compute_alpha_int(self, beta, kappa) + !< Compute alpha. + class(alpha_rec_z), intent(inout) :: self !< Alpha. + class(beta_object), intent(in) :: beta !< Beta. + class(kappa_object), intent(in) :: kappa !< Kappa. + + ! Empty subroutine. + endsubroutine compute_alpha_int + + pure subroutine compute_alpha_rec(self, beta, kappa) !< Compute alpha. class(alpha_rec_z), intent(inout) :: self !< Alpha. class(beta_object), intent(in) :: beta !< Beta. @@ -62,13 +74,13 @@ pure subroutine compute(self, beta, kappa) self%values_sum = 0._RPP do s1=0, self%S - 1 ! stencil loops - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) self%values(f, s1) = kappa%values(f, s1) * & ((1._RPP + (tau(S=self%S, beta=beta%values) / (self%eps + beta%values(f, s1)))) ** (weno_exp(self%S))) self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo enddo - endsubroutine compute + endsubroutine compute_alpha_rec pure function description(self) result(string) !< Return alpha string-descripition. @@ -78,9 +90,6 @@ pure function description(self) result(string) string = ' Borges alpha coefficients for reconstructor:'//nl string = string//' - S = '//trim(str(self%S))//nl - string = string//' - f1 = '//trim(str(self%f1))//nl - string = string//' - f2 = '//trim(str(self%f2))//nl - string = string//' - ff = '//trim(str(self%ff))//nl string = string//' - eps = '//trim(str(self%eps)) endfunction description diff --git a/src/lib/concrete_objects/wenoof_beta_int_js.F90 b/src/lib/concrete_objects/wenoof_beta_int_js.F90 index 2df8d75..ef278c5 100644 --- a/src/lib/concrete_objects/wenoof_beta_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_int_js.F90 @@ -29,14 +29,16 @@ module wenoof_beta_int_js !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. + real(RPP), allocatable :: values(:) !< Beta values [0:S-1]. private - real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [1:2,0:S-1,0:S-1]. + real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [0:S-1,0:S-1,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create beta. - procedure, pass(self) :: compute !< Compute beta. - procedure, pass(self) :: description !< Return beta string-description. - procedure, pass(self) :: destroy !< Destroy beta. + procedure, pass(self) :: create !< Create beta. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute beta. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute beta. + procedure, pass(self) :: description !< Return beta string-description. + procedure, pass(self) :: destroy !< Destroy beta. endtype beta_int_js contains @@ -48,7 +50,7 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) + allocate(self%values(0:self%S - 1)) self%values = 0._RPP allocate(self%coef(0:self%S - 1, 0:self%S - 1, 0:self%S - 1)) associate(c => self%coef) @@ -2371,24 +2373,29 @@ subroutine create(self, constructor) endassociate endsubroutine create - pure subroutine compute(self, stencil) + pure subroutine compute_with_stencil_of_rank_1(self, stencil) !< Compute beta. - class(beta_int_js), intent(inout) :: self !< Beta. - real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - integer(I_P) :: s1, s2, s3, f !< Counters. + class(beta_int_js), intent(inout) :: self !< Beta. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + integer(I_P) :: s1, s2, s3 !< Counters. do s1=0, self%S - 1 ! stencils loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = 0._RPP - do s2=0, self%S - 1 - do s3=0, self%S - 1 - self%values(f, s1) = self%values(f, s1) + & - self%coef(s3, s2, s1) * stencil(f + self%ff, s1 - s3) * stencil(f + self%ff, s1 - s2) - enddo + self%values(f, s1) = 0._RPP + do s2=0, self%S - 1 + do s3=0, self%S - 1 + self%values(s1) = self%values(s1) + self%coef(s3, s2, s1) * stencil(s1 - s3) * stencil(s1 - s2) enddo enddo enddo - endsubroutine compute + endsubroutine compute_with_stencil_of_rank_1 + + pure subroutine compute_with_stencil_of_rank_2(self, stencil) + !< Compute beta. + class(beta_int_js), intent(inout) :: self !< Beta. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + + ! Empty subroutine. + endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) !< Return beta string-description. diff --git a/src/lib/concrete_objects/wenoof_beta_rec_js.F90 b/src/lib/concrete_objects/wenoof_beta_rec_js.F90 index bf79b96..fd88e48 100644 --- a/src/lib/concrete_objects/wenoof_beta_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_rec_js.F90 @@ -31,8 +31,9 @@ module wenoof_beta_rec_js !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 + real(RPP), allocatable :: values(:,:) !< Beta values [1:2,0:S-1]. private - real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [1:2,0:S-1,0:S-1]. + real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [0:S-1,0:S-1,0:S-1]. contains ! public deferred methods procedure, pass(self) :: create !< Create beta. @@ -2373,24 +2374,31 @@ subroutine create(self, constructor) endassociate endsubroutine create - pure subroutine compute(self, stencil) + pure subroutine compute_with_stencil_of_rank_1(self, stencil) + !< Compute beta. + class(beta_rec_js), intent(inout) :: self !< Beta. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + + ! Empty routine. + endsubroutine compute_with_stencil_of_rank_1 + + pure subroutine compute_with_stencil_of_rank_2(self, stencil) !< Compute beta. class(beta_rec_js), intent(inout) :: self !< Beta. real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. integer(I_P) :: s1, s2, s3, f !< Counters. do s1=0, self%S - 1 ! stencils loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) self%values(f, s1) = 0._RPP do s2=0, self%S - 1 do s3=0, self%S - 1 - self%values(f, s1) = self%values(f, s1) + & - self%coef(s3, s2, s1) * stencil(f + self%ff, s1 - s3) * stencil(f + self%ff, s1 - s2) + self%values(f, s1) = self%values(f, s1) + self%coef(s3, s2, s1) * stencil(f, s1 - s3) * stencil(f, s1 - s2) enddo enddo enddo enddo - endsubroutine compute + endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) !< Return beta string-description. diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index 0f374bf..6b4f182 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -29,14 +29,16 @@ module wenoof_interpolations_int_js !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. + real(RPP), allocatable :: values(:) !< Interpolations values [0:S-1]. private - real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [1:2,0:S-1,0:S-1]. + real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [0:S-1,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create interpolations. - procedure, pass(self) :: compute !< Compute interpolations. - procedure, pass(self) :: description !< Return interpolations string-description. - procedure, pass(self) :: destroy !< Destroy interpolations. + procedure, pass(self) :: create !< Create interpolations. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute interpolations. + procedure, pass(self) :: compute_with_stencil_of_rank_2 !< Compute interpolations. + procedure, pass(self) :: description !< Return interpolations string-description. + procedure, pass(self) :: destroy !< Destroy interpolations. endtype interpolations_int_js contains @@ -48,294 +50,299 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) + allocate(self%values(0:self%S - 1)) self%values = 0._RPP - allocate(self%coef(1:2, 0:self%S - 1, 0:self%S - 1)) + allocate(self%coef(0:self%S - 1, 0:self%S - 1)) associate(c => self%coef) select case(self%S) case(2) ! 3rd order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 - c(1,0,0)= 0.5_RPP; c(1,1,0)= 0.5_RPP ! stencil 0 - c(1,0,1)= 1.5_RPP; c(1,1,1)= -0.5_RPP ! stencil 1 + ! cell 0 ; cell 1 + c(0,0)= 0.5_RPP; c(1,0)= 0.5_RPP ! stencil 0 + c(0,1)= 1.5_RPP; c(1,1)= -0.5_RPP ! stencil 1 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 - c(2,0,0)= -0.5_RPP; c(2,1,0)= 1.5_RPP ! stencil 0 - c(2,0,1)= 0.5_RPP; c(2,1,1)= 0.5_RPP ! stencil 1 + ! cell 0 ; cell 1 + c(0,0)= -0.5_RPP; c(1,0)= 1.5_RPP ! stencil 0 + c(0,1)= 0.5_RPP; c(1,1)= 0.5_RPP ! stencil 1 case(3) ! 5th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(1,0,0)= -1._RPP/8._RPP; c(1,1,0)= 3._RPP/4._RPP; c(1,2,0)= 3._RPP/8._RPP ! stencil 0 - c(1,0,1)= 3._RPP/8._RPP; c(1,1,1)= 3._RPP/4._RPP; c(1,2,1)= -1._RPP/8._RPP ! stencil 1 - c(1,0,2)= 15._RPP/8._RPP; c(1,1,2)= -5._RPP/4._RPP; c(1,2,2)= 3._RPP/8._RPP ! stencil 2 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(2,0)= 3._RPP/8._RPP ! stencil 0 + c(0,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= -1._RPP/8._RPP ! stencil 1 + c(0,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(2,2)= 3._RPP/8._RPP ! stencil 2 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(2,0,0)= 3._RPP/8._RPP; c(2,1,0)= -5._RPP/4._RPP; c(2,2,0)= 15._RPP/8._RPP ! stencil 0 - c(2,0,1)= -1._RPP/8._RPP; c(2,1,1)= 3._RPP/4._RPP; c(2,2,1)= 3._RPP/8._RPP ! stencil 1 - c(2,0,2)= 3._RPP/8._RPP; c(2,1,2)= 3._RPP/4._RPP; c(2,2,2)= -1._RPP/8._RPP ! stencil 2 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(2,0)= 15._RPP/8._RPP ! stencil 0 + c(0,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= 3._RPP/8._RPP ! stencil 1 + c(0,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(2,2)= -1._RPP/8._RPP ! stencil 2 case(4) ! 7th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(1,0,0)= 1._RPP/16._RPP; c(1,1,0)= -5._RPP/16._RPP; c(1,2,0)= 15._RPP/16._RPP; c(1,3,0)= 5._RPP/16._RPP ! stencil 0 - c(1,0,1)= -1._RPP/16._RPP; c(1,1,1)= 9._RPP/16._RPP; c(1,2,1)= 9._RPP/16._RPP; c(1,3,1)= -1._RPP/16._RPP ! stencil 1 - c(1,0,2)= 5._RPP/16._RPP; c(1,1,2)= 15._RPP/16._RPP; c(1,2,2)= -5._RPP/16._RPP; c(1,3,2)= 1._RPP/16._RPP ! stencil 2 - c(1,0,3)= 35._RPP/16._RPP; c(1,1,3)=-35._RPP/16._RPP; c(1,2,3)= 21._RPP/16._RPP; c(1,3,3)= -5._RPP/16._RPP ! stencil 3 + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 1._RPP/16._RPP; c(1,0)= -5._RPP/16._RPP; c(2,0)= 15._RPP/16._RPP; c(3,0)= 5._RPP/16._RPP ! stencil 0 + c(0,1)= -1._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(3,1)= -1._RPP/16._RPP ! stencil 1 + c(0,2)= 5._RPP/16._RPP; c(1,2)= 15._RPP/16._RPP; c(2,2)= -5._RPP/16._RPP; c(3,2)= 1._RPP/16._RPP ! stencil 2 + c(0,3)= 35._RPP/16._RPP; c(1,3)=-35._RPP/16._RPP; c(2,3)= 21._RPP/16._RPP; c(3,3)= -5._RPP/16._RPP ! stencil 3 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(2,0,0)= -5._RPP/16._RPP; c(2,1,0)= 21._RPP/16._RPP; c(2,2,0)=-35._RPP/16._RPP; c(2,3,0)= 35._RPP/16._RPP ! stencil 0 - c(2,0,1)= 1._RPP/16._RPP; c(2,1,1)= -5._RPP/16._RPP; c(2,2,1)= 15._RPP/16._RPP; c(2,3,1)= 5._RPP/16._RPP ! stencil 1 - c(2,0,2)= -1._RPP/16._RPP; c(2,1,2)= 9._RPP/16._RPP; c(2,2,2)= 9._RPP/16._RPP; c(2,3,2)= -1._RPP/16._RPP ! stencil 2 - c(2,0,3)= 5._RPP/16._RPP; c(2,1,3)= 15._RPP/16._RPP; c(2,2,3)= -5._RPP/16._RPP; c(2,3,3)= 1._RPP/16._RPP ! stencil 3 + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -5._RPP/16._RPP; c(1,0)= 21._RPP/16._RPP; c(2,0)=-35._RPP/16._RPP; c(3,0)= 35._RPP/16._RPP ! stencil 0 + c(0,1)= 1._RPP/16._RPP; c(1,1)= -5._RPP/16._RPP; c(2,1)= 15._RPP/16._RPP; c(3,1)= 5._RPP/16._RPP ! stencil 1 + c(0,2)= -1._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(3,2)= -1._RPP/16._RPP ! stencil 2 + c(0,3)= 5._RPP/16._RPP; c(1,3)= 15._RPP/16._RPP; c(2,3)= -5._RPP/16._RPP; c(3,3)= 1._RPP/16._RPP ! stencil 3 case(5) ! 9th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(1,0,0)= -5._RPP/128._RPP; c(1,1,0)= 7._RPP/32._RPP ; c(1,2,0)= -35._RPP/64._RPP ; c(1,3,0)= 35._RPP/32._RPP ! stencil 0 - c(1,0,1)= 3._RPP/128._RPP; c(1,1,1)= -5._RPP/32._RPP ; c(1,2,1)= 45._RPP/64._RPP ; c(1,3,1)= 15._RPP/32._RPP ! stencil 1 - c(1,0,2)= -5._RPP/128._RPP; c(1,1,2)= 15._RPP/32._RPP ; c(1,2,2)= 45._RPP/64._RPP ; c(1,3,2)= -5._RPP/32._RPP ! stencil 2 - c(1,0,3)= 35._RPP/128._RPP; c(1,1,3)= 35._RPP/32._RPP ; c(1,2,3)= -35._RPP/64._RPP ; c(1,3,3)= 7._RPP/32._RPP ! stencil 3 - c(1,0,4)= 315._RPP/128._RPP; c(1,1,4)=-105._RPP/32._RPP ; c(1,2,4)= 189._RPP/64._RPP ; c(1,3,4)= -45._RPP/32._RPP ! stencil 4 + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -5._RPP/128._RPP; c(1,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(3,0)= 35._RPP/32._RPP ! stencil 0 + c(0,1)= 3._RPP/128._RPP; c(1,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(3,1)= 15._RPP/32._RPP ! stencil 1 + c(0,2)= -5._RPP/128._RPP; c(1,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= -5._RPP/32._RPP ! stencil 2 + c(0,3)= 35._RPP/128._RPP; c(1,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(3,3)= 7._RPP/32._RPP ! stencil 3 + c(0,4)= 315._RPP/128._RPP; c(1,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(3,4)= -45._RPP/32._RPP ! stencil 4 ! cell 4 - c(1,4,0)= 35._RPP/128._RPP ! stencil 0 - c(1,4,1)= -5._RPP/128._RPP ! stencil 1 - c(1,4,2)= 3._RPP/128._RPP ! stencil 2 - c(1,4,3)= -5._RPP/128._RPP ! stencil 3 - c(1,4,4)= 35._RPP/128._RPP ! stencil 4 + c(4,0)= 35._RPP/128._RPP ! stencil 0 + c(4,1)= -5._RPP/128._RPP ! stencil 1 + c(4,2)= 3._RPP/128._RPP ! stencil 2 + c(4,3)= -5._RPP/128._RPP ! stencil 3 + c(4,4)= 35._RPP/128._RPP ! stencil 4 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(2,0,0)= 35._RPP/128._RPP; c(2,1,0)= -45._RPP/32._RPP ; c(2,2,0)= 189._RPP/64._RPP ; c(2,3,0)=-105._RPP/32._RPP ! stencil 0 - c(2,0,1)= -5._RPP/128._RPP; c(2,1,1)= 7._RPP/32._RPP ; c(2,2,1)= -35._RPP/64._RPP ; c(2,3,1)= 35._RPP/32._RPP ! stencil 1 - c(2,0,2)= 3._RPP/128._RPP; c(2,1,2)= -5._RPP/32._RPP ; c(2,2,2)= 45._RPP/64._RPP ; c(2,3,2)= 15._RPP/32._RPP ! stencil 2 - c(2,0,3)= -5._RPP/128._RPP; c(2,1,3)= 15._RPP/32._RPP ; c(2,2,3)= 45._RPP/64._RPP ; c(2,3,3)= -5._RPP/32._RPP ! stencil 3 - c(2,0,4)= 35._RPP/128._RPP; c(2,1,4)= 35._RPP/32._RPP ; c(2,2,4)= -35._RPP/64._RPP ; c(2,3,4)= 7._RPP/32._RPP ! stencil 4 + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 35._RPP/128._RPP; c(1,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(3,0)=-105._RPP/32._RPP ! stencil 0 + c(0,1)= -5._RPP/128._RPP; c(1,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(3,1)= 35._RPP/32._RPP ! stencil 1 + c(0,2)= 3._RPP/128._RPP; c(1,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= 15._RPP/32._RPP ! stencil 2 + c(0,3)= -5._RPP/128._RPP; c(1,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(3,3)= -5._RPP/32._RPP ! stencil 3 + c(0,4)= 35._RPP/128._RPP; c(1,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(3,4)= 7._RPP/32._RPP ! stencil 4 ! cell 4 - c(2,4,0)= 315._RPP/128._RPP ! stencil 0 - c(2,4,1)= 35._RPP/128._RPP ! stencil 1 - c(2,4,2)= -5._RPP/128._RPP ! stencil 2 - c(2,4,3)= 3._RPP/128._RPP ! stencil 3 - c(2,4,4)= -5._RPP/128._RPP ! stencil 4 + c(4,0)= 315._RPP/128._RPP ! stencil 0 + c(4,1)= 35._RPP/128._RPP ! stencil 1 + c(4,2)= -5._RPP/128._RPP ! stencil 2 + c(4,3)= 3._RPP/128._RPP ! stencil 3 + c(4,4)= -5._RPP/128._RPP ! stencil 4 case(6) ! 11th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(1,0,0)= 7._RPP/256._RPP; c(1,1,0)= -45._RPP/256._RPP; c(1,2,0)= 63._RPP/128._RPP; c(1,3,0)= -105._RPP/128._RPP ! stencil 0 - c(1,0,1)= -3._RPP/256._RPP; c(1,1,1)= 21._RPP/256._RPP; c(1,2,1)= -35._RPP/128._RPP; c(1,3,1)= 105._RPP/128._RPP ! stencil 1 - c(1,0,2)= 3._RPP/256._RPP; c(1,1,2)= -25._RPP/256._RPP; c(1,2,2)= 75._RPP/128._RPP; c(1,3,2)= 75._RPP/128._RPP ! stencil 2 - c(1,0,3)= -7._RPP/256._RPP; c(1,1,3)= 105._RPP/256._RPP; c(1,2,3)= 105._RPP/128._RPP; c(1,3,3)= -35._RPP/128._RPP ! stencil 3 - c(1,0,4)= 63._RPP/256._RPP; c(1,1,4)= 315._RPP/256._RPP; c(1,2,4)= -105._RPP/128._RPP; c(1,3,4)= 63._RPP/128._RPP ! stencil 4 - c(1,0,5)= 693._RPP/256._RPP; c(1,1,5)=-1155._RPP/256._RPP; c(1,2,5)= 693._RPP/128._RPP; c(1,3,5)= -495._RPP/128._RPP ! stencil 5 - ! cell 4 ; cell 5 - c(1,4,0)= 315._RPP/256._RPP; c(1,5,0)= 63._RPP/256._RPP ! stencil 0 - c(1,4,1)= 105._RPP/256._RPP; c(1,5,1)= -7._RPP/256._RPP ! stencil 1 - c(1,4,2)= -25._RPP/256._RPP; c(1,5,2)= 3._RPP/256._RPP ! stencil 2 - c(1,4,3)= 21._RPP/256._RPP; c(1,5,3)= -3._RPP/256._RPP ! stencil 3 - c(1,4,4)= -45._RPP/256._RPP; c(1,5,4)= 7._RPP/256._RPP ! stencil 4 - c(1,4,5)= 385._RPP/256._RPP; c(1,5,5)= -63._RPP/256._RPP ! stencil 5 + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP; c(3,0)= -105._RPP/128._RPP ! stencil 0 + c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP; c(3,1)= 105._RPP/128._RPP ! stencil 1 + c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP; c(3,2)= 75._RPP/128._RPP ! stencil 2 + c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP; c(3,3)= -35._RPP/128._RPP ! stencil 3 + c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP; c(3,4)= 63._RPP/128._RPP ! stencil 4 + c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP; c(3,5)= -495._RPP/128._RPP ! stencil 5 + ! cell 4 ; cell 5 + c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 + c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 + c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 + c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 + c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 + c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(2,0,0)= -63._RPP/256._RPP; c(2,1,0)= 385._RPP/256._RPP; c(2,2,0)= -495._RPP/128._RPP; c(2,3,0)= 693._RPP/128._RPP ! stencil 0 - c(2,0,1)= 7._RPP/256._RPP; c(2,1,1)= -45._RPP/256._RPP; c(2,2,1)= 63._RPP/128._RPP; c(2,3,1)= -105._RPP/128._RPP ! stencil 1 - c(2,0,2)= -3._RPP/256._RPP; c(2,1,2)= 21._RPP/256._RPP; c(2,2,2)= -35._RPP/128._RPP; c(2,3,2)= 105._RPP/128._RPP ! stencil 2 - c(2,0,3)= 3._RPP/256._RPP; c(2,1,3)= -25._RPP/256._RPP; c(2,2,3)= 75._RPP/128._RPP; c(2,3,3)= 75._RPP/128._RPP ! stencil 3 - c(2,0,4)= -7._RPP/256._RPP; c(2,1,4)= 105._RPP/256._RPP; c(2,2,4)= 105._RPP/128._RPP; c(2,3,4)= -35._RPP/128._RPP ! stencil 4 - c(2,0,5)= 63._RPP/256._RPP; c(2,1,5)= 315._RPP/256._RPP; c(2,2,5)= -105._RPP/128._RPP; c(2,3,5)= 63._RPP/128._RPP ! stencil 5 - ! cell 4 ; cell 5 - c(2,4,0)=-1155._RPP/256._RPP; c(2,5,0)= 693._RPP/256._RPP ! stencil 0 - c(2,4,1)= 315._RPP/256._RPP; c(2,5,1)= 63._RPP/256._RPP ! stencil 1 - c(2,4,2)= 105._RPP/256._RPP; c(2,5,2)= -7._RPP/256._RPP ! stencil 2 - c(2,4,3)= -25._RPP/256._RPP; c(2,5,3)= 3._RPP/256._RPP ! stencil 3 - c(2,4,4)= 21._RPP/256._RPP; c(2,5,4)= -3._RPP/256._RPP ! stencil 4 - c(2,4,5)= -45._RPP/256._RPP; c(2,5,5)= 7._RPP/256._RPP ! stencil 5 + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP; c(3,0)= 693._RPP/128._RPP ! stencil 0 + c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP; c(3,1)= -105._RPP/128._RPP ! stencil 1 + c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP; c(3,2)= 105._RPP/128._RPP ! stencil 2 + c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP; c(3,3)= 75._RPP/128._RPP ! stencil 3 + c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP; c(3,4)= -35._RPP/128._RPP ! stencil 4 + c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP; c(3,5)= 63._RPP/128._RPP ! stencil 5 + ! cell 4 ; cell 5 + c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 + c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 + c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 + c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 + c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 + c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 case(7) ! 13th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(1,0,0)= -21._RPP/1024._RPP; c(1,1,0)= 77._RPP/512._RPP ; c(1,2,0)= -495._RPP/1024._RPP ! stencil 0 - c(1,0,1)= 7._RPP/1024._RPP; c(1,1,1)= -27._RPP/512._RPP ; c(1,2,1)= 189._RPP/1024._RPP ! stencil 1 - c(1,0,2)= -5._RPP/1024._RPP; c(1,1,2)= 21._RPP/512._RPP ; c(1,2,2)= -175._RPP/1024._RPP ! stencil 2 - c(1,0,3)= 7._RPP/1024._RPP; c(1,1,3)= -35._RPP/512._RPP ; c(1,2,3)= 525._RPP/1024._RPP ! stencil 3 - c(1,0,4)= -21._RPP/1024._RPP; c(1,1,4)= 189._RPP/512._RPP ; c(1,2,4)= 945._RPP/1024._RPP ! stencil 4 - c(1,0,5)= 231._RPP/1024._RPP; c(1,1,5)= 693._RPP/512._RPP ; c(1,2,5)=-1155._RPP/1024._RPP ! stencil 5 - c(1,0,6)= 3003._RPP/1024._RPP; c(1,1,6)=-3003._RPP/512._RPP ; c(1,2,6)= 9009._RPP/1024._RPP ! stencil 6 - ! cell 3 cell 4 ; cell 5 - c(1,3,0)= 231._RPP/256._RPP ; c(1,4,0)=-1155._RPP/1024._RPP; c(1,5,0)= 693._RPP/512._RPP ! stencil 0 - c(1,3,1)= -105._RPP/256._RPP ; c(1,4,1)= 945._RPP/1024._RPP; c(1,5,1)= 189._RPP/512._RPP ! stencil 1 - c(1,3,2)= 175._RPP/256._RPP ; c(1,4,2)= 525._RPP/1024._RPP; c(1,5,2)= -35._RPP/512._RPP ! stencil 2 - c(1,3,3)= 175._RPP/256._RPP ; c(1,4,3)= -175._RPP/1024._RPP; c(1,5,3)= 21._RPP/512._RPP ! stencil 3 - c(1,3,4)= -105._RPP/256._RPP ; c(1,4,4)= 189._RPP/1024._RPP; c(1,5,4)= -27._RPP/512._RPP ! stencil 4 - c(1,3,5)= 231._RPP/256._RPP ; c(1,4,5)= -495._RPP/1024._RPP; c(1,5,5)= 77._RPP/512._RPP ! stencil 5 - c(1,3,6)=-2145._RPP/256._RPP ; c(1,4,6)= 5005._RPP/1024._RPP; c(1,5,6)= -819._RPP/512._RPP ! stencil 6 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 + c(0,1)= 7._RPP/1024._RPP; c(1,1)= -27._RPP/512._RPP ; c(2,1)= 189._RPP/1024._RPP ! stencil 1 + c(0,2)= -5._RPP/1024._RPP; c(1,2)= 21._RPP/512._RPP ; c(2,2)= -175._RPP/1024._RPP ! stencil 2 + c(0,3)= 7._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ; c(2,3)= 525._RPP/1024._RPP ! stencil 3 + c(0,4)= -21._RPP/1024._RPP; c(1,4)= 189._RPP/512._RPP ; c(2,4)= 945._RPP/1024._RPP ! stencil 4 + c(0,5)= 231._RPP/1024._RPP; c(1,5)= 693._RPP/512._RPP ; c(2,5)=-1155._RPP/1024._RPP ! stencil 5 + c(0,6)= 3003._RPP/1024._RPP; c(1,6)=-3003._RPP/512._RPP ; c(2,6)= 9009._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 231._RPP/256._RPP ; c(4,0)=-1155._RPP/1024._RPP; c(5,0)= 693._RPP/512._RPP ! stencil 0 + c(3,1)= -105._RPP/256._RPP ; c(4,1)= 945._RPP/1024._RPP; c(5,1)= 189._RPP/512._RPP ! stencil 1 + c(3,2)= 175._RPP/256._RPP ; c(4,2)= 525._RPP/1024._RPP; c(5,2)= -35._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(4,3)= -175._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ! stencil 3 + c(3,4)= -105._RPP/256._RPP ; c(4,4)= 189._RPP/1024._RPP; c(5,4)= -27._RPP/512._RPP ! stencil 4 + c(3,5)= 231._RPP/256._RPP ; c(4,5)= -495._RPP/1024._RPP; c(5,5)= 77._RPP/512._RPP ! stencil 5 + c(3,6)=-2145._RPP/256._RPP ; c(4,6)= 5005._RPP/1024._RPP; c(5,6)= -819._RPP/512._RPP ! stencil 6 ! cell 6 - c(1,6,0)= 231._RPP/1024._RPP ! stencil 0 - c(1,6,1)= -21._RPP/1024._RPP ! stencil 1 - c(1,6,2)= 7._RPP/1024._RPP ! stencil 2 - c(1,6,3)= -5._RPP/1024._RPP ! stencil 3 - c(1,6,4)= 7._RPP/1024._RPP ! stencil 4 - c(1,6,5)= -21._RPP/1024._RPP ! stencil 5 - c(1,6,6)= 231._RPP/1024._RPP ! stencil 6 + c(6,0)= 231._RPP/1024._RPP ! stencil 0 + c(6,1)= -21._RPP/1024._RPP ! stencil 1 + c(6,2)= 7._RPP/1024._RPP ! stencil 2 + c(6,3)= -5._RPP/1024._RPP ! stencil 3 + c(6,4)= 7._RPP/1024._RPP ! stencil 4 + c(6,5)= -21._RPP/1024._RPP ! stencil 5 + c(6,6)= 231._RPP/1024._RPP ! stencil 6 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(2,0,0)= 231._RPP/1024._RPP; c(2,1,0)= -819._RPP/512._RPP ; c(2,2,0)= 5005._RPP/1024._RPP ! stencil 0 - c(2,0,1)= -21._RPP/1024._RPP; c(2,1,1)= 77._RPP/512._RPP ; c(2,2,1)= -495._RPP/1024._RPP ! stencil 1 - c(2,0,2)= 7._RPP/1024._RPP; c(2,1,2)= -27._RPP/512._RPP ; c(2,2,2)= 189._RPP/1024._RPP ! stencil 2 - c(2,0,3)= -5._RPP/1024._RPP; c(2,1,3)= 21._RPP/512._RPP ; c(2,2,3)= -175._RPP/1024._RPP ! stencil 3 - c(2,0,4)= 7._RPP/1024._RPP; c(2,1,4)= -35._RPP/512._RPP ; c(2,2,4)= 525._RPP/1024._RPP ! stencil 4 - c(2,0,5)= -21._RPP/1024._RPP; c(2,1,5)= 189._RPP/512._RPP ; c(2,2,5)= 945._RPP/1024._RPP ! stencil 5 - c(2,0,6)= 231._RPP/1024._RPP; c(2,1,6)= 693._RPP/512._RPP ; c(2,2,6)=-1155._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(2,3,0)=-2145._RPP/256._RPP ; c(2,4,0)= 9009._RPP/1024._RPP; c(2,5,0)=-3003._RPP/512._RPP ! stencil 0 - c(2,3,1)= 231._RPP/256._RPP ; c(2,4,1)=-1155._RPP/1024._RPP; c(2,5,1)= 693._RPP/512._RPP ! stencil 1 - c(2,3,2)= -105._RPP/256._RPP ; c(2,4,2)= 945._RPP/1024._RPP; c(2,5,2)= 189._RPP/512._RPP ! stencil 2 - c(2,3,3)= 175._RPP/256._RPP ; c(2,4,3)= 525._RPP/1024._RPP; c(2,5,3)= -35._RPP/512._RPP ! stencil 3 - c(2,3,4)= 175._RPP/256._RPP ; c(2,4,4)= -175._RPP/1024._RPP; c(2,5,4)= 21._RPP/512._RPP ! stencil 4 - c(2,3,5)= -105._RPP/256._RPP ; c(2,4,5)= 189._RPP/1024._RPP; c(2,5,5)= -27._RPP/512._RPP ! stencil 5 - c(2,3,6)= 231._RPP/256._RPP ; c(2,4,6)= -495._RPP/1024._RPP; c(2,5,6)= 77._RPP/512._RPP ! stencil 6 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 + c(0,1)= -21._RPP/1024._RPP; c(1,1)= 77._RPP/512._RPP ; c(2,1)= -495._RPP/1024._RPP ! stencil 1 + c(0,2)= 7._RPP/1024._RPP; c(1,2)= -27._RPP/512._RPP ; c(2,2)= 189._RPP/1024._RPP ! stencil 2 + c(0,3)= -5._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ; c(2,3)= -175._RPP/1024._RPP ! stencil 3 + c(0,4)= 7._RPP/1024._RPP; c(1,4)= -35._RPP/512._RPP ; c(2,4)= 525._RPP/1024._RPP ! stencil 4 + c(0,5)= -21._RPP/1024._RPP; c(1,5)= 189._RPP/512._RPP ; c(2,5)= 945._RPP/1024._RPP ! stencil 5 + c(0,6)= 231._RPP/1024._RPP; c(1,6)= 693._RPP/512._RPP ; c(2,6)=-1155._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)=-2145._RPP/256._RPP ; c(4,0)= 9009._RPP/1024._RPP; c(5,0)=-3003._RPP/512._RPP ! stencil 0 + c(3,1)= 231._RPP/256._RPP ; c(4,1)=-1155._RPP/1024._RPP; c(5,1)= 693._RPP/512._RPP ! stencil 1 + c(3,2)= -105._RPP/256._RPP ; c(4,2)= 945._RPP/1024._RPP; c(5,2)= 189._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(4,3)= 525._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ! stencil 3 + c(3,4)= 175._RPP/256._RPP ; c(4,4)= -175._RPP/1024._RPP; c(5,4)= 21._RPP/512._RPP ! stencil 4 + c(3,5)= -105._RPP/256._RPP ; c(4,5)= 189._RPP/1024._RPP; c(5,5)= -27._RPP/512._RPP ! stencil 5 + c(3,6)= 231._RPP/256._RPP ; c(4,6)= -495._RPP/1024._RPP; c(5,6)= 77._RPP/512._RPP ! stencil 6 ! cell 6 - c(2,6,0)= 3003._RPP/1024._RPP ! stencil 0 - c(2,6,1)= 231._RPP/1024._RPP ! stencil 1 - c(2,6,2)= -21._RPP/1024._RPP ! stencil 2 - c(2,6,3)= 7._RPP/1024._RPP ! stencil 3 - c(2,6,4)= -5._RPP/1024._RPP ! stencil 4 - c(2,6,5)= 7._RPP/1024._RPP ! stencil 5 - c(2,6,6)= -21._RPP/1024._RPP ! stencil 6 + c(6,0)= 3003._RPP/1024._RPP ! stencil 0 + c(6,1)= 231._RPP/1024._RPP ! stencil 1 + c(6,2)= -21._RPP/1024._RPP ! stencil 2 + c(6,3)= 7._RPP/1024._RPP ! stencil 3 + c(6,4)= -5._RPP/1024._RPP ! stencil 4 + c(6,5)= 7._RPP/1024._RPP ! stencil 5 + c(6,6)= -21._RPP/1024._RPP ! stencil 6 case(8) ! 15th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(1,0,0)= 33._RPP/2048._RPP; c(1,1,0)= -273._RPP/2048._RPP; c(1,2,0)= 1001._RPP/2048._RPP ! stencil 0 - c(1,0,1)= -9._RPP/2048._RPP; c(1,1,1)= 77._RPP/2048._RPP; c(1,2,1)= -297._RPP/2048._RPP ! stencil 1 - c(1,0,2)= 5._RPP/2048._RPP; c(1,1,2)= -45._RPP/2048._RPP; c(1,2,2)= 189._RPP/2048._RPP ! stencil 2 - c(1,0,3)= -5._RPP/2048._RPP; c(1,1,3)= 49._RPP/2048._RPP; c(1,2,3)= -245._RPP/2048._RPP ! stencil 3 - c(1,0,4)= 9._RPP/2048._RPP; c(1,1,4)= -105._RPP/2048._RPP; c(1,2,4)= 945._RPP/2048._RPP ! stencil 4 - c(1,0,5)= -33._RPP/2048._RPP; c(1,1,5)= 693._RPP/2048._RPP; c(1,2,5)= 2079._RPP/2048._RPP ! stencil 5 - c(1,0,6)= 429._RPP/2048._RPP; c(1,1,6)= 3003._RPP/2048._RPP; c(1,2,6)= -3003._RPP/2048._RPP ! stencil 6 - c(1,0,7)= 6435._RPP/2048._RPP; c(1,1,7)=-15015._RPP/2048._RPP; c(1,2,7)= 27027._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(1,3,0)= -2145._RPP/2048._RPP; c(1,4,0)= 3003._RPP/2048._RPP; c(1,5,0)= -3003._RPP/2048._RPP ! stencil 0 - c(1,3,1)= 693._RPP/2048._RPP; c(1,4,1)= -1155._RPP/2048._RPP; c(1,5,1)= 2079._RPP/2048._RPP ! stencil 1 - c(1,3,2)= -525._RPP/2048._RPP; c(1,4,2)= 1575._RPP/2048._RPP; c(1,5,2)= 945._RPP/2048._RPP ! stencil 2 - c(1,3,3)= 1225._RPP/2048._RPP; c(1,4,3)= 1225._RPP/2048._RPP; c(1,5,3)= -245._RPP/2048._RPP ! stencil 3 - c(1,3,4)= 1575._RPP/2048._RPP; c(1,4,4)= -525._RPP/2048._RPP; c(1,5,4)= 189._RPP/2048._RPP ! stencil 4 - c(1,3,5)= -1155._RPP/2048._RPP; c(1,4,5)= 693._RPP/2048._RPP; c(1,5,5)= -297._RPP/2048._RPP ! stencil 5 - c(1,3,6)= 3003._RPP/2048._RPP; c(1,4,6)= -2145._RPP/2048._RPP; c(1,5,6)= 1001._RPP/2048._RPP ! stencil 6 - c(1,3,7)=-32175._RPP/2048._RPP; c(1,4,7)= 25025._RPP/2048._RPP; c(1,5,7)=-12285._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(1,6,0)= 3003._RPP/2048._RPP; c(1,7,0)= 429._RPP/2048._RPP ! stencil 0 - c(1,6,1)= 693._RPP/2048._RPP; c(1,7,1)= -33._RPP/2048._RPP ! stencil 1 - c(1,6,2)= -105._RPP/2048._RPP; c(1,7,2)= 9._RPP/2048._RPP ! stencil 2 - c(1,6,3)= 49._RPP/2048._RPP; c(1,7,3)= -5._RPP/2048._RPP ! stencil 3 - c(1,6,4)= -45._RPP/2048._RPP; c(1,7,4)= 5._RPP/2048._RPP ! stencil 4 - c(1,6,5)= 77._RPP/2048._RPP; c(1,7,5)= -9._RPP/2048._RPP ! stencil 5 - c(1,6,6)= -273._RPP/2048._RPP; c(1,7,6)= 33._RPP/2048._RPP ! stencil 6 - c(1,6,7)= 3465._RPP/2048._RPP; c(1,7,7)= -429._RPP/2048._RPP ! stencil 7 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 33._RPP/2048._RPP; c(1,0)= -273._RPP/2048._RPP; c(2,0)= 1001._RPP/2048._RPP ! stencil 0 + c(0,1)= -9._RPP/2048._RPP; c(1,1)= 77._RPP/2048._RPP; c(2,1)= -297._RPP/2048._RPP ! stencil 1 + c(0,2)= 5._RPP/2048._RPP; c(1,2)= -45._RPP/2048._RPP; c(2,2)= 189._RPP/2048._RPP ! stencil 2 + c(0,3)= -5._RPP/2048._RPP; c(1,3)= 49._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 + c(0,4)= 9._RPP/2048._RPP; c(1,4)= -105._RPP/2048._RPP; c(2,4)= 945._RPP/2048._RPP ! stencil 4 + c(0,5)= -33._RPP/2048._RPP; c(1,5)= 693._RPP/2048._RPP; c(2,5)= 2079._RPP/2048._RPP ! stencil 5 + c(0,6)= 429._RPP/2048._RPP; c(1,6)= 3003._RPP/2048._RPP; c(2,6)= -3003._RPP/2048._RPP ! stencil 6 + c(0,7)= 6435._RPP/2048._RPP; c(1,7)=-15015._RPP/2048._RPP; c(2,7)= 27027._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= -2145._RPP/2048._RPP; c(4,0)= 3003._RPP/2048._RPP; c(5,0)= -3003._RPP/2048._RPP ! stencil 0 + c(3,1)= 693._RPP/2048._RPP; c(4,1)= -1155._RPP/2048._RPP; c(5,1)= 2079._RPP/2048._RPP ! stencil 1 + c(3,2)= -525._RPP/2048._RPP; c(4,2)= 1575._RPP/2048._RPP; c(5,2)= 945._RPP/2048._RPP ! stencil 2 + c(3,3)= 1225._RPP/2048._RPP; c(4,3)= 1225._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 + c(3,4)= 1575._RPP/2048._RPP; c(4,4)= -525._RPP/2048._RPP; c(5,4)= 189._RPP/2048._RPP ! stencil 4 + c(3,5)= -1155._RPP/2048._RPP; c(4,5)= 693._RPP/2048._RPP; c(5,5)= -297._RPP/2048._RPP ! stencil 5 + c(3,6)= 3003._RPP/2048._RPP; c(4,6)= -2145._RPP/2048._RPP; c(5,6)= 1001._RPP/2048._RPP ! stencil 6 + c(3,7)=-32175._RPP/2048._RPP; c(4,7)= 25025._RPP/2048._RPP; c(5,7)=-12285._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(6,0)= 3003._RPP/2048._RPP; c(7,0)= 429._RPP/2048._RPP ! stencil 0 + c(6,1)= 693._RPP/2048._RPP; c(7,1)= -33._RPP/2048._RPP ! stencil 1 + c(6,2)= -105._RPP/2048._RPP; c(7,2)= 9._RPP/2048._RPP ! stencil 2 + c(6,3)= 49._RPP/2048._RPP; c(7,3)= -5._RPP/2048._RPP ! stencil 3 + c(6,4)= -45._RPP/2048._RPP; c(7,4)= 5._RPP/2048._RPP ! stencil 4 + c(6,5)= 77._RPP/2048._RPP; c(7,5)= -9._RPP/2048._RPP ! stencil 5 + c(6,6)= -273._RPP/2048._RPP; c(7,6)= 33._RPP/2048._RPP ! stencil 6 + c(6,7)= 3465._RPP/2048._RPP; c(7,7)= -429._RPP/2048._RPP ! stencil 7 ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(2,0,0)= -429._RPP/2048._RPP; c(2,1,0)= 3465._RPP/2048._RPP; c(2,2,0)=-12285._RPP/2048._RPP ! stencil 0 - c(2,0,1)= 33._RPP/2048._RPP; c(2,1,1)= -273._RPP/2048._RPP; c(2,2,1)= 1001._RPP/2048._RPP ! stencil 1 - c(2,0,2)= -9._RPP/2048._RPP; c(2,1,2)= 77._RPP/2048._RPP; c(2,2,2)= -297._RPP/2048._RPP ! stencil 2 - c(2,0,3)= 5._RPP/2048._RPP; c(2,1,3)= -45._RPP/2048._RPP; c(2,2,3)= 189._RPP/2048._RPP ! stencil 3 - c(2,0,4)= -5._RPP/2048._RPP; c(2,1,4)= 49._RPP/2048._RPP; c(2,2,4)= -245._RPP/2048._RPP ! stencil 4 - c(2,0,5)= 9._RPP/2048._RPP; c(2,1,5)= -105._RPP/2048._RPP; c(2,2,5)= 945._RPP/2048._RPP ! stencil 5 - c(2,0,6)= -33._RPP/2048._RPP; c(2,1,6)= 693._RPP/2048._RPP; c(2,2,6)= 2079._RPP/2048._RPP ! stencil 6 - c(2,0,7)= 429._RPP/2048._RPP; c(2,1,7)= 3003._RPP/2048._RPP; c(2,2,7)= -3003._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(2,3,0)= 25025._RPP/2048._RPP; c(2,4,0)=-32175._RPP/2048._RPP; c(2,5,0)= 27027._RPP/2048._RPP ! stencil 0 - c(2,3,1)= -2145._RPP/2048._RPP; c(2,4,1)= 3003._RPP/2048._RPP; c(2,5,1)= -3003._RPP/2048._RPP ! stencil 1 - c(2,3,2)= 693._RPP/2048._RPP; c(2,4,2)= -1155._RPP/2048._RPP; c(2,5,2)= 2079._RPP/2048._RPP ! stencil 2 - c(2,3,3)= -525._RPP/2048._RPP; c(2,4,3)= 1575._RPP/2048._RPP; c(2,5,3)= 945._RPP/2048._RPP ! stencil 3 - c(2,3,4)= 1225._RPP/2048._RPP; c(2,4,4)= 1225._RPP/2048._RPP; c(2,5,4)= -245._RPP/2048._RPP ! stencil 4 - c(2,3,5)= 1575._RPP/2048._RPP; c(2,4,5)= -525._RPP/2048._RPP; c(2,5,5)= 189._RPP/2048._RPP ! stencil 5 - c(2,3,6)= -1155._RPP/2048._RPP; c(2,4,6)= 693._RPP/2048._RPP; c(2,5,6)= -297._RPP/2048._RPP ! stencil 6 - c(2,3,7)= 3003._RPP/2048._RPP; c(2,4,7)= -2145._RPP/2048._RPP; c(2,5,7)= 1001._RPP/2048._RPP ! stencil 7 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -429._RPP/2048._RPP; c(1,0)= 3465._RPP/2048._RPP; c(2,0)=-12285._RPP/2048._RPP ! stencil 0 + c(0,1)= 33._RPP/2048._RPP; c(1,1)= -273._RPP/2048._RPP; c(2,1)= 1001._RPP/2048._RPP ! stencil 1 + c(0,2)= -9._RPP/2048._RPP; c(1,2)= 77._RPP/2048._RPP; c(2,2)= -297._RPP/2048._RPP ! stencil 2 + c(0,3)= 5._RPP/2048._RPP; c(1,3)= -45._RPP/2048._RPP; c(2,3)= 189._RPP/2048._RPP ! stencil 3 + c(0,4)= -5._RPP/2048._RPP; c(1,4)= 49._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 + c(0,5)= 9._RPP/2048._RPP; c(1,5)= -105._RPP/2048._RPP; c(2,5)= 945._RPP/2048._RPP ! stencil 5 + c(0,6)= -33._RPP/2048._RPP; c(1,6)= 693._RPP/2048._RPP; c(2,6)= 2079._RPP/2048._RPP ! stencil 6 + c(0,7)= 429._RPP/2048._RPP; c(1,7)= 3003._RPP/2048._RPP; c(2,7)= -3003._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 25025._RPP/2048._RPP; c(4,0)=-32175._RPP/2048._RPP; c(5,0)= 27027._RPP/2048._RPP ! stencil 0 + c(3,1)= -2145._RPP/2048._RPP; c(4,1)= 3003._RPP/2048._RPP; c(5,1)= -3003._RPP/2048._RPP ! stencil 1 + c(3,2)= 693._RPP/2048._RPP; c(4,2)= -1155._RPP/2048._RPP; c(5,2)= 2079._RPP/2048._RPP ! stencil 2 + c(3,3)= -525._RPP/2048._RPP; c(4,3)= 1575._RPP/2048._RPP; c(5,3)= 945._RPP/2048._RPP ! stencil 3 + c(3,4)= 1225._RPP/2048._RPP; c(4,4)= 1225._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 + c(3,5)= 1575._RPP/2048._RPP; c(4,5)= -525._RPP/2048._RPP; c(5,5)= 189._RPP/2048._RPP ! stencil 5 + c(3,6)= -1155._RPP/2048._RPP; c(4,6)= 693._RPP/2048._RPP; c(5,6)= -297._RPP/2048._RPP ! stencil 6 + c(3,7)= 3003._RPP/2048._RPP; c(4,7)= -2145._RPP/2048._RPP; c(5,7)= 1001._RPP/2048._RPP ! stencil 7 ! cell 6 ; cell 7 - c(2,6,0)=-15015._RPP/2048._RPP; c(2,7,0)= 6435._RPP/2048._RPP ! stencil 0 - c(2,6,1)= 3003._RPP/2048._RPP; c(2,7,1)= 429._RPP/2048._RPP ! stencil 1 - c(2,6,2)= 693._RPP/2048._RPP; c(2,7,2)= -33._RPP/2048._RPP ! stencil 2 - c(2,6,3)= -105._RPP/2048._RPP; c(2,7,3)= 9._RPP/2048._RPP ! stencil 3 - c(2,6,4)= 49._RPP/2048._RPP; c(2,7,4)= -5._RPP/2048._RPP ! stencil 4 - c(2,6,5)= -45._RPP/2048._RPP; c(2,7,5)= 5._RPP/2048._RPP ! stencil 5 - c(2,6,6)= 77._RPP/2048._RPP; c(2,7,6)= -9._RPP/2048._RPP ! stencil 6 - c(2,6,7)= -273._RPP/2048._RPP; c(2,7,7)= 33._RPP/2048._RPP ! stencil 7 + c(6,0)=-15015._RPP/2048._RPP; c(7,0)= 6435._RPP/2048._RPP ! stencil 0 + c(6,1)= 3003._RPP/2048._RPP; c(7,1)= 429._RPP/2048._RPP ! stencil 1 + c(6,2)= 693._RPP/2048._RPP; c(7,2)= -33._RPP/2048._RPP ! stencil 2 + c(6,3)= -105._RPP/2048._RPP; c(7,3)= 9._RPP/2048._RPP ! stencil 3 + c(6,4)= 49._RPP/2048._RPP; c(7,4)= -5._RPP/2048._RPP ! stencil 4 + c(6,5)= -45._RPP/2048._RPP; c(7,5)= 5._RPP/2048._RPP ! stencil 5 + c(6,6)= 77._RPP/2048._RPP; c(7,6)= -9._RPP/2048._RPP ! stencil 6 + c(6,7)= -273._RPP/2048._RPP; c(7,7)= 33._RPP/2048._RPP ! stencil 7 case(9) ! 17th order ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(1,0,0)= -429._RPP/32768._RPP; c(1,1,0)= 495._RPP/4096._RPP ; c(1,2,0)= -4095._RPP/8192._RPP ! stencil 0 - c(1,0,1)= 99._RPP/32768._RPP; c(1,1,1)= -117._RPP/4096._RPP ; c(1,2,1)= 1001._RPP/8192._RPP ! stencil 1 - c(1,0,2)= -45._RPP/32768._RPP; c(1,1,2)= 55._RPP/4096._RPP ; c(1,2,2)= -495._RPP/8192._RPP ! stencil 2 - c(1,0,3)= 35._RPP/32768._RPP; c(1,1,3)= -45._RPP/4096._RPP ; c(1,2,3)= 441._RPP/8192._RPP ! stencil 3 - c(1,0,4)= -45._RPP/32768._RPP; c(1,1,4)= 63._RPP/4096._RPP ; c(1,2,4)= -735._RPP/8192._RPP ! stencil 4 - c(1,0,5)= 99._RPP/32768._RPP; c(1,1,5)= -165._RPP/4096._RPP ; c(1,2,5)= 3465._RPP/8192._RPP ! stencil 5 - c(1,0,6)= -429._RPP/32768._RPP; c(1,1,6)= 1287._RPP/4096._RPP ; c(1,2,6)= 9009._RPP/8192._RPP ! stencil 6 - c(1,0,7)= 6435._RPP/32768._RPP; c(1,1,7)= 6435._RPP/4096._RPP ; c(1,2,7)= -15015._RPP/8192._RPP ! stencil 7 - c(1,0,8)= 109395._RPP/32768._RPP; c(1,1,8)= -36465._RPP/4096._RPP ; c(1,2,8)= 153153._RPP/8192._RPP ! stencil 8 - ! cell 3 ; cell 4 ; cell 5 - c(1,3,0)= 5005._RPP/4096._RPP ; c(1,4,0)= -32175._RPP/16384._RPP; c(1,5,0)= 9009._RPP/4096._RPP ! stencil 0 - c(1,3,1)= -1287._RPP/4096._RPP ; c(1,4,1)= 9009._RPP/16384._RPP; c(1,5,1)= -3003._RPP/4096._RPP ! stencil 1 - c(1,3,2)= 693._RPP/4096._RPP ; c(1,4,2)= -5775._RPP/16384._RPP; c(1,5,2)= 3465._RPP/4096._RPP ! stencil 2 - c(1,3,3)= -735._RPP/4096._RPP ; c(1,4,3)= 11025._RPP/16384._RPP; c(1,5,3)= 2205._RPP/4096._RPP ! stencil 3 - c(1,3,4)= 2205._RPP/4096._RPP ; c(1,4,4)= 11025._RPP/16384._RPP; c(1,5,4)= -735._RPP/4096._RPP ! stencil 4 - c(1,3,5)= 3465._RPP/4096._RPP ; c(1,4,5)= -5775._RPP/16384._RPP; c(1,5,5)= 693._RPP/4096._RPP ! stencil 5 - c(1,3,6)= -3003._RPP/4096._RPP ; c(1,4,6)= 9009._RPP/16384._RPP; c(1,5,6)= -1287._RPP/4096._RPP ! stencil 6 - c(1,3,7)= 9009._RPP/4096._RPP ; c(1,4,7)= -32175._RPP/16384._RPP; c(1,5,7)= 5005._RPP/4096._RPP ! stencil 7 - c(1,3,8)=-109395._RPP/4096._RPP ; c(1,4,8)= 425425._RPP/16384._RPP; c(1,5,8)= -69615._RPP/4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(1,6,0)= -15015._RPP/8192._RPP ; c(1,7,0)= 6435._RPP/4096._RPP ; c(1,8,0)= 6435._RPP/32768._RPP ! stencil 0 - c(1,6,1)= 9009._RPP/8192._RPP ; c(1,7,1)= 1287._RPP/4096._RPP ; c(1,8,1)= -429._RPP/32768._RPP ! stencil 1 - c(1,6,2)= 3465._RPP/8192._RPP ; c(1,7,2)= -165._RPP/4096._RPP ; c(1,8,2)= 99._RPP/32768._RPP ! stencil 2 - c(1,6,3)= -735._RPP/8192._RPP ; c(1,7,3)= 63._RPP/4096._RPP ; c(1,8,3)= -45._RPP/32768._RPP ! stencil 3 - c(1,6,4)= 441._RPP/8192._RPP ; c(1,7,4)= -45._RPP/4096._RPP ; c(1,8,4)= 35._RPP/32768._RPP ! stencil 4 - c(1,6,5)= -495._RPP/8192._RPP ; c(1,7,5)= 55._RPP/4096._RPP ; c(1,8,5)= -45._RPP/32768._RPP ! stencil 5 - c(1,6,6)= 1001._RPP/8192._RPP ; c(1,7,6)= -117._RPP/4096._RPP ; c(1,8,6)= 99._RPP/32768._RPP ! stencil 6 - c(1,6,7)= -4095._RPP/8192._RPP ; c(1,7,7)= 495._RPP/4096._RPP ; c(1,8,7)= -429._RPP/32768._RPP ! stencil 7 - c(1,6,8)= 58905._RPP/8192._RPP ; c(1,7,8)= -7293._RPP/4096._RPP ; c(1,8,8)= 6435._RPP/32768._RPP ! stencil 8 - ! 2 => right interface (i+1/2) ! cell 0 ; cell 1 ; cell 2 - c(2,0,0)= 6435._RPP/32768._RPP; c(2,1,0)= -7293._RPP/ 4096._RPP; c(2,2,0)= 58905._RPP/ 8192._RPP ! stencil 0 - c(2,0,1)= -429._RPP/32768._RPP; c(2,1,1)= 495._RPP/ 4096._RPP; c(2,2,1)= -4095._RPP/ 8192._RPP ! stencil 1 - c(2,0,2)= 99._RPP/32768._RPP; c(2,1,2)= -117._RPP/ 4096._RPP; c(2,2,2)= 1001._RPP/ 8192._RPP ! stencil 2 - c(2,0,3)= -45._RPP/32768._RPP; c(2,1,3)= 55._RPP/ 4096._RPP; c(2,2,3)= -495._RPP/ 8192._RPP ! stencil 3 - c(2,0,4)= 35._RPP/32768._RPP; c(2,1,4)= -45._RPP/ 4096._RPP; c(2,2,4)= 441._RPP/ 8192._RPP ! stencil 4 - c(2,0,5)= -45._RPP/32768._RPP; c(2,1,5)= 63._RPP/ 4096._RPP; c(2,2,5)= -735._RPP/ 8192._RPP ! stencil 5 - c(2,0,6)= 99._RPP/32768._RPP; c(2,1,6)= -165._RPP/ 4096._RPP; c(2,2,6)= 3465._RPP/ 8192._RPP ! stencil 6 - c(2,0,7)= -429._RPP/32768._RPP; c(2,1,7)= 1287._RPP/ 4096._RPP; c(2,2,7)= 9009._RPP/ 8192._RPP ! stencil 7 - c(2,0,8)= 6435._RPP/32768._RPP; c(2,1,8)= 6435._RPP/ 4096._RPP; c(2,2,8)= -15015._RPP/ 8192._RPP ! stencil 8 - ! cell 3 ; ! cell 4 ; cell 5 - c(2,3,0)= -69615._RPP/ 4096._RPP; c(2,4,0)= 425425._RPP/16384._RPP; c(2,5,0)=-109395._RPP/ 4096._RPP ! stencil 0 - c(2,3,1)= 5005._RPP/ 4096._RPP; c(2,4,1)= -32175._RPP/16384._RPP; c(2,5,1)= 9009._RPP/ 4096._RPP ! stencil 1 - c(2,3,2)= -1287._RPP/ 4096._RPP; c(2,4,2)= 9009._RPP/16384._RPP; c(2,5,2)= -3003._RPP/ 4096._RPP ! stencil 2 - c(2,3,3)= 693._RPP/ 4096._RPP; c(2,4,3)= -5775._RPP/16384._RPP; c(2,5,3)= 3465._RPP/ 4096._RPP ! stencil 3 - c(2,3,4)= -735._RPP/ 4096._RPP; c(2,4,4)= 11025._RPP/16384._RPP; c(2,5,4)= 2205._RPP/ 4096._RPP ! stencil 4 - c(2,3,5)= 2205._RPP/ 4096._RPP; c(2,4,5)= 11025._RPP/16384._RPP; c(2,5,5)= -735._RPP/ 4096._RPP ! stencil 5 - c(2,3,6)= 3465._RPP/ 4096._RPP; c(2,4,6)= -5775._RPP/16384._RPP; c(2,5,6)= 693._RPP/ 4096._RPP ! stencil 6 - c(2,3,7)= -3003._RPP/ 4096._RPP; c(2,4,7)= 9009._RPP/16384._RPP; c(2,5,7)= -1287._RPP/ 4096._RPP ! stencil 7 - c(2,3,8)= 9009._RPP/ 4096._RPP; c(2,4,8)= -32175._RPP/16384._RPP; c(2,5,8)= 5005._RPP/ 4096._RPP ! stencil 8 + c(0,0)= -429._RPP/32768._RPP; c(1,0)= 495._RPP/4096._RPP ; c(2,0)= -4095._RPP/8192._RPP ! stencil 0 + c(0,1)= 99._RPP/32768._RPP; c(1,1)= -117._RPP/4096._RPP ; c(2,1)= 1001._RPP/8192._RPP ! stencil 1 + c(0,2)= -45._RPP/32768._RPP; c(1,2)= 55._RPP/4096._RPP ; c(2,2)= -495._RPP/8192._RPP ! stencil 2 + c(0,3)= 35._RPP/32768._RPP; c(1,3)= -45._RPP/4096._RPP ; c(2,3)= 441._RPP/8192._RPP ! stencil 3 + c(0,4)= -45._RPP/32768._RPP; c(1,4)= 63._RPP/4096._RPP ; c(2,4)= -735._RPP/8192._RPP ! stencil 4 + c(0,5)= 99._RPP/32768._RPP; c(1,5)= -165._RPP/4096._RPP ; c(2,5)= 3465._RPP/8192._RPP ! stencil 5 + c(0,6)= -429._RPP/32768._RPP; c(1,6)= 1287._RPP/4096._RPP ; c(2,6)= 9009._RPP/8192._RPP ! stencil 6 + c(0,7)= 6435._RPP/32768._RPP; c(1,7)= 6435._RPP/4096._RPP ; c(2,7)= -15015._RPP/8192._RPP ! stencil 7 + c(0,8)= 109395._RPP/32768._RPP; c(1,8)= -36465._RPP/4096._RPP ; c(2,8)= 153153._RPP/8192._RPP ! stencil 8 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(5,0)= 9009._RPP/4096._RPP ! stencil 0 + c(3,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(5,1)= -3003._RPP/4096._RPP ! stencil 1 + c(3,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(5,2)= 3465._RPP/4096._RPP ! stencil 2 + c(3,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(5,3)= 2205._RPP/4096._RPP ! stencil 3 + c(3,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= -735._RPP/4096._RPP ! stencil 4 + c(3,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(5,5)= 693._RPP/4096._RPP ! stencil 5 + c(3,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(5,6)= -1287._RPP/4096._RPP ! stencil 6 + c(3,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(5,7)= 5005._RPP/4096._RPP ! stencil 7 + c(3,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(5,8)= -69615._RPP/4096._RPP ! stencil 8 ! cell 6 ; cell 7 ; cell 8 - c(2,6,0)= 153153._RPP/ 8192._RPP; c(2,7,0)= -36465._RPP/ 4096._RPP; c(2,8,0)= 109395._RPP/32768._RPP ! stencil 0 - c(2,6,1)= -15015._RPP/ 8192._RPP; c(2,7,1)= 6435._RPP/ 4096._RPP; c(2,8,1)= 6435._RPP/32768._RPP ! stencil 1 - c(2,6,2)= 9009._RPP/ 8192._RPP; c(2,7,2)= 1287._RPP/ 4096._RPP; c(2,8,2)= -429._RPP/32768._RPP ! stencil 2 - c(2,6,3)= 3465._RPP/ 8192._RPP; c(2,7,3)= -165._RPP/ 4096._RPP; c(2,8,3)= 99._RPP/32768._RPP ! stencil 3 - c(2,6,4)= -735._RPP/ 8192._RPP; c(2,7,4)= 63._RPP/ 4096._RPP; c(2,8,4)= -45._RPP/32768._RPP ! stencil 4 - c(2,6,5)= 441._RPP/ 8192._RPP; c(2,7,5)= -45._RPP/ 4096._RPP; c(2,8,5)= 35._RPP/32768._RPP ! stencil 5 - c(2,6,6)= -495._RPP/ 8192._RPP; c(2,7,6)= 55._RPP/ 4096._RPP; c(2,8,6)= -45._RPP/32768._RPP ! stencil 6 - c(2,6,7)= 1001._RPP/ 8192._RPP; c(2,7,7)= -117._RPP/ 4096._RPP; c(2,8,7)= 99._RPP/32768._RPP ! stencil 7 - c(2,6,8)= -4095._RPP/ 8192._RPP; c(2,7,8)= 495._RPP/ 4096._RPP; c(2,8,8)= -429._RPP/32768._RPP ! stencil 8 + c(6,0)= -15015._RPP/8192._RPP ; c(7,0)= 6435._RPP/4096._RPP ; c(8,0)= 6435._RPP/32768._RPP ! stencil 0 + c(6,1)= 9009._RPP/8192._RPP ; c(7,1)= 1287._RPP/4096._RPP ; c(8,1)= -429._RPP/32768._RPP ! stencil 1 + c(6,2)= 3465._RPP/8192._RPP ; c(7,2)= -165._RPP/4096._RPP ; c(8,2)= 99._RPP/32768._RPP ! stencil 2 + c(6,3)= -735._RPP/8192._RPP ; c(7,3)= 63._RPP/4096._RPP ; c(8,3)= -45._RPP/32768._RPP ! stencil 3 + c(6,4)= 441._RPP/8192._RPP ; c(7,4)= -45._RPP/4096._RPP ; c(8,4)= 35._RPP/32768._RPP ! stencil 4 + c(6,5)= -495._RPP/8192._RPP ; c(7,5)= 55._RPP/4096._RPP ; c(8,5)= -45._RPP/32768._RPP ! stencil 5 + c(6,6)= 1001._RPP/8192._RPP ; c(7,6)= -117._RPP/4096._RPP ; c(8,6)= 99._RPP/32768._RPP ! stencil 6 + c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 + c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 + ! 2 => right interface (i+1/2) + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 6435._RPP/32768._RPP; c(1,0)= -7293._RPP/ 4096._RPP; c(2,0)= 58905._RPP/ 8192._RPP ! stencil 0 + c(0,1)= -429._RPP/32768._RPP; c(1,1)= 495._RPP/ 4096._RPP; c(2,1)= -4095._RPP/ 8192._RPP ! stencil 1 + c(0,2)= 99._RPP/32768._RPP; c(1,2)= -117._RPP/ 4096._RPP; c(2,2)= 1001._RPP/ 8192._RPP ! stencil 2 + c(0,3)= -45._RPP/32768._RPP; c(1,3)= 55._RPP/ 4096._RPP; c(2,3)= -495._RPP/ 8192._RPP ! stencil 3 + c(0,4)= 35._RPP/32768._RPP; c(1,4)= -45._RPP/ 4096._RPP; c(2,4)= 441._RPP/ 8192._RPP ! stencil 4 + c(0,5)= -45._RPP/32768._RPP; c(1,5)= 63._RPP/ 4096._RPP; c(2,5)= -735._RPP/ 8192._RPP ! stencil 5 + c(0,6)= 99._RPP/32768._RPP; c(1,6)= -165._RPP/ 4096._RPP; c(2,6)= 3465._RPP/ 8192._RPP ! stencil 6 + c(0,7)= -429._RPP/32768._RPP; c(1,7)= 1287._RPP/ 4096._RPP; c(2,7)= 9009._RPP/ 8192._RPP ! stencil 7 + c(0,8)= 6435._RPP/32768._RPP; c(1,8)= 6435._RPP/ 4096._RPP; c(2,8)= -15015._RPP/ 8192._RPP ! stencil 8 + ! cell 3 ; ! cell 4 ; cell 5 + c(3,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(5,0)=-109395._RPP/ 4096._RPP ! stencil 0 + c(3,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(5,1)= 9009._RPP/ 4096._RPP ! stencil 1 + c(3,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(5,2)= -3003._RPP/ 4096._RPP ! stencil 2 + c(3,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(5,3)= 3465._RPP/ 4096._RPP ! stencil 3 + c(3,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= 2205._RPP/ 4096._RPP ! stencil 4 + c(3,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(5,5)= -735._RPP/ 4096._RPP ! stencil 5 + c(3,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(5,6)= 693._RPP/ 4096._RPP ! stencil 6 + c(3,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(5,7)= -1287._RPP/ 4096._RPP ! stencil 7 + c(3,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(5,8)= 5005._RPP/ 4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(6,0)= 153153._RPP/ 8192._RPP; c(7,0)= -36465._RPP/ 4096._RPP; c(8,0)= 109395._RPP/32768._RPP ! stencil 0 + c(6,1)= -15015._RPP/ 8192._RPP; c(7,1)= 6435._RPP/ 4096._RPP; c(8,1)= 6435._RPP/32768._RPP ! stencil 1 + c(6,2)= 9009._RPP/ 8192._RPP; c(7,2)= 1287._RPP/ 4096._RPP; c(8,2)= -429._RPP/32768._RPP ! stencil 2 + c(6,3)= 3465._RPP/ 8192._RPP; c(7,3)= -165._RPP/ 4096._RPP; c(8,3)= 99._RPP/32768._RPP ! stencil 3 + c(6,4)= -735._RPP/ 8192._RPP; c(7,4)= 63._RPP/ 4096._RPP; c(8,4)= -45._RPP/32768._RPP ! stencil 4 + c(6,5)= 441._RPP/ 8192._RPP; c(7,5)= -45._RPP/ 4096._RPP; c(8,5)= 35._RPP/32768._RPP ! stencil 5 + c(6,6)= -495._RPP/ 8192._RPP; c(7,6)= 55._RPP/ 4096._RPP; c(8,6)= -45._RPP/32768._RPP ! stencil 6 + c(6,7)= 1001._RPP/ 8192._RPP; c(7,7)= -117._RPP/ 4096._RPP; c(8,7)= 99._RPP/32768._RPP ! stencil 7 + c(6,8)= -4095._RPP/ 8192._RPP; c(7,8)= 495._RPP/ 4096._RPP; c(8,8)= -429._RPP/32768._RPP ! stencil 8 endselect endassociate endsubroutine create - pure subroutine compute(self, stencil) + pure subroutine compute_with_stencil_of_rank_1(self, stencil) !< Compute interpolations. - class(interpolations_int_js), intent(inout) :: self !< Interpolations. - real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - integer(I_P) :: s1 !< Counter. - integer(I_P) :: s2 !< Counter. - integer(I_P) :: f !< Counter. + class(interpolations_int_js), intent(inout) :: self !< Interpolations. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + integer(I_P) :: s1 !< Counter. + integer(I_P) :: s2 !< Counter. self%values = 0._RPP do s1=0, self%S - 1 ! stencils loop do s2=0, self%S - 1 ! values loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = self%values(f, s1) + self%coef(f, s2, s1) * stencil(f + self%ff, -s2 + s1) - enddo + self%values(s1) = self%values(s1) + self%coef(s2, s1) * stencil(-s2 + s1) enddo enddo - endsubroutine compute + endsubroutine compute_with_stencil_of_rank_1 + + pure subroutine compute_with_stencil_of_rank_2(self, stencil) + !< Compute interpolations. + class(interpolations_int_js), intent(inout) :: self !< Interpolations. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + + ! Empty Subroutine. + endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) !< Return interpolations string-description. diff --git a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 index 2b89618..14cc4c0 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 @@ -31,6 +31,7 @@ module wenoof_interpolations_rec_js !< of Weighted ENO Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 + real(RPP), allocatable :: values(:,:) !< Interpolations values [1:2,0:S-1]. private real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [1:2,0:S-1,0:S-1]. contains @@ -450,7 +451,15 @@ subroutine create(self, constructor) endassociate endsubroutine create - pure subroutine compute(self, stencil) + pure subroutine compute_with_stencil_of_rank_1(self, stencil) + !< Compute interpolations. + class(interpolations_rec_js), intent(inout) :: self !< Interpolations. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + + ! Empty Subroutine. + endsubroutine compute_with_stencil_of_rank_1 + + pure subroutine compute_with_stencil_of_rank_2(self, stencil) !< Compute interpolations. class(interpolations_rec_js), intent(inout) :: self !< Interpolations. real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. @@ -461,12 +470,12 @@ pure subroutine compute(self, stencil) self%values = 0._RPP do s1=0, self%S - 1 ! stencils loop do s2=0, self%S - 1 ! values loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = self%values(f, s1) + self%coef(f, s2, s1) * stencil(f + self%ff, -s2 + s1) + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + self%values(f, s1) = self%values(f, s1) + self%coef(f, s2, s1) * stencil(f, -s2 + s1) enddo enddo enddo - endsubroutine compute + endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) !< Return interpolations string-description. diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index 487474f..8bb2822 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -67,9 +67,6 @@ pure function description(self) result(string) string = 'Jiang-Shu reconstructor:'//nl string = string//' - S = '//trim(str(self%S))//nl - string = string//' - f1 = '//trim(str(self%f1))//nl - string = string//' - f2 = '//trim(str(self%f2))//nl - string = string//' - ff = '//trim(str(self%ff))//nl string = string//self%weights%description() endfunction description @@ -82,34 +79,51 @@ elemental subroutine destroy(self) if (allocated(self%weights)) deallocate(self%weights) endsubroutine destroy - pure subroutine interpolate_debug(self, stencil, interpolation, si, weights) + pure subroutine interpolate_with_stencil_of_rank_1_debug(self, stencil, interpolation, si, weights) !< Interpolate values (providing also debug values). - class(interpolator_js), intent(inout) :: self !< Interpolator. - real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. - real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. - real(RPP), intent(out) :: si(1:, 0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. - real(RPP), intent(out) :: weights(1:, 0:) !< Weights of the stencils, [1:2, 0:S-1]. + class(interpolator_js), intent(inout) :: self !< Interpolator. + real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation, [1:2]. + real(RPP), intent(out) :: si(0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. + real(RPP), intent(out) :: weights(0:) !< Weights of the stencils, [1:2, 0:S-1]. call self%interpolate_standard(stencil=stencil, interpolation=interpolation) si = self%weights%smoothness_indicators() weights = self%weights%values - endsubroutine interpolate_debug + endsubroutine interpolate_with_stencil_of_rank_1_debug - pure subroutine interpolate_standard(self, stencil, interpolation) + pure subroutine interpolate_with_stencil_of_rank_2_debug(self, stencil, interpolation, si, weights) + !< Interpolate values (providing also debug values). + class(interpolator_js), intent(inout) :: self !< Reconstructor. + real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. + real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. + real(RPP), intent(out) :: si(1:, 0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. + real(RPP), intent(out) :: weights(1:, 0:) !< Weights of the stencils, [1:2, 0:S-1]. + + ! Empty subroutine. + endsubroutine interpolate_with_stencil_of_rank_2_debug + + pure subroutine interpolate_with_stencil_of_rank_1_standard(self, stencil, interpolation) !< Interpolate values (without providing debug values). - class(interpolator_js), intent(inout) :: self !< Interpolator. - real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. - real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. - integer(I_P) :: f, s !< Counters. + class(interpolator_js), intent(inout) :: self !< Interpolator. + real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation, [1:2]. + integer(I_P) :: s !< Counters. call self%interpolations%compute(stencil=stencil) call self%weights%compute(stencil=stencil) interpolation = 0._RPP do s=0, self%S - 1 ! stencils loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - interpolation(f + self%ff) = interpolation(f + self%ff) + & - self%weights%values(f + self%ff, s) * self%interpolations%values(f, s) - enddo + interpolation = interpolation + self%weights%values(s) * self%interpolations%values(s) enddo - endsubroutine interpolate_standard + endsubroutine interpolate_with_stencil_of_rank_1_standard + + pure subroutine interpolate_with_stencil_of_rank_2_standard(self, stencil, interpolation) + !< Interpolate values (without providing debug values). + class(reconstructor_js), intent(inout) :: self !< Reconstructor. + real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. + real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. + + ! Empty subroutine. + endsubroutine interpolate_with_stencil_of_rank_2_standard endmodule wenoof_interpolator_js diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 0362a88..4c712f4 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -29,12 +29,14 @@ module wenoof_kappa_int_js !< @note The provided WENO kappa implements the linear weights defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. + real(RPP), allocatable :: values(:) !< Kappa coefficients values [0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute !< Compute kappa. - procedure, pass(self) :: description !< Return kappa string-description. - procedure, pass(self) :: destroy !< Destroy kappa. + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute_kappa_int !< Compute kappa. + procedure, pass(self) :: compute_kappa_rec !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_int_js contains @@ -48,12 +50,12 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) + allocate(self%values(0:self%S - 1)) self%values = 0._RPP call self%compute endsubroutine create - pure subroutine compute(self) + pure subroutine compute_kappa_int(self) !< Compute kappa. class(kappa_int_js), intent(inout) :: self !< Kappa. @@ -61,119 +63,126 @@ pure subroutine compute(self) select case(self%S) case(2) ! 3rd order ! 1 => left interface (i-1/2) - val(1, 0) = 3._RPP/4._RPP ! stencil 0 - val(1, 1) = 1._RPP/4._RPP ! stencil 1 + val(0) = 3._RPP/4._RPP ! stencil 0 + val(1) = 1._RPP/4._RPP ! stencil 1 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/4._RPP ! stencil 0 - val(2, 1) = 3._RPP/4._RPP ! stencil 1 + val(0) = 1._RPP/4._RPP ! stencil 0 + val(1) = 3._RPP/4._RPP ! stencil 1 case(3) ! 5th order ! 1 => left interface (i-1/2) - val(1, 0) = 5._RPP/16._RPP ! stencil 0 - val(1, 1) = 5._RPP/8._RPP ! stencil 1 - val(1, 2) = 1._RPP/16._RPP ! stencil 2 + val(0) = 5._RPP/16._RPP ! stencil 0 + val(1) = 5._RPP/8._RPP ! stencil 1 + val(2) = 1._RPP/16._RPP ! stencil 2 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/16._RPP ! stencil 0 - val(2, 1) = 5._RPP/8._RPP ! stencil 1 - val(2, 2) = 5._RPP/16._RPP ! stencil 2 + val(0) = 1._RPP/16._RPP ! stencil 0 + val(1) = 5._RPP/8._RPP ! stencil 1 + val(2) = 5._RPP/16._RPP ! stencil 2 case(4) ! 7th order ! 1 => left interface (i-1/2) - val(1, 0) = 7._RPP/64._RPP ! stencil 0 - val(1, 1) = 35._RPP/64._RPP ! stencil 1 - val(1, 2) = 21._RPP/64._RPP ! stencil 2 - val(1, 3) = 1._RPP/64._RPP ! stencil 3 + val(0) = 7._RPP/64._RPP ! stencil 0 + val(1) = 35._RPP/64._RPP ! stencil 1 + val(2) = 21._RPP/64._RPP ! stencil 2 + val(3) = 1._RPP/64._RPP ! stencil 3 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/64._RPP ! stencil 0 - val(2, 1) = 21._RPP/64._RPP ! stencil 1 - val(2, 2) = 35._RPP/64._RPP ! stencil 2 - val(2, 3) = 7._RPP/64._RPP ! stencil 3 + val(0) = 1._RPP/64._RPP ! stencil 0 + val(1) = 21._RPP/64._RPP ! stencil 1 + val(2) = 35._RPP/64._RPP ! stencil 2 + val(3) = 7._RPP/64._RPP ! stencil 3 case(5) ! 9th order ! 1 => left interface (i-1/2) - val(1, 0) = 9._RPP/256._RPP ! stencil 0 - val(1, 1) = 21._RPP/64._RPP ! stencil 1 - val(1, 2) = 63._RPP/128._RPP ! stencil 2 - val(1, 3) = 9._RPP/64._RPP ! stencil 3 - val(1, 4) = 1._RPP/256._RPP ! stencil 4 + val(0) = 9._RPP/256._RPP ! stencil 0 + val(1) = 21._RPP/64._RPP ! stencil 1 + val(2) = 63._RPP/128._RPP ! stencil 2 + val(3) = 9._RPP/64._RPP ! stencil 3 + val(4) = 1._RPP/256._RPP ! stencil 4 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/256._RPP ! stencil 0 - val(2, 1) = 9._RPP/64._RPP ! stencil 1 - val(2, 2) = 63._RPP/128._RPP ! stencil 2 - val(2, 3) = 21._RPP/64._RPP ! stencil 3 - val(2, 4) = 9._RPP/256._RPP ! stencil 4 + val(0) = 1._RPP/256._RPP ! stencil 0 + val(1) = 9._RPP/64._RPP ! stencil 1 + val(2) = 63._RPP/128._RPP ! stencil 2 + val(3) = 21._RPP/64._RPP ! stencil 3 + val(4) = 9._RPP/256._RPP ! stencil 4 case(6) ! 11th order ! 1 => left interface (i-1/2) - val(1, 0) = 11._RPP/1024._RPP ! stencil 0 - val(1, 1) = 165._RPP/1024._RPP ! stencil 1 - val(1, 2) = 231._RPP/512._RPP ! stencil 2 - val(1, 3) = 165._RPP/512._RPP ! stencil 3 - val(1, 4) = 55._RPP/1024._RPP ! stencil 4 - val(1, 5) = 1._RPP/1024._RPP ! stencil 5 + val(0) = 11._RPP/1024._RPP ! stencil 0 + val(1) = 165._RPP/1024._RPP ! stencil 1 + val(2) = 231._RPP/512._RPP ! stencil 2 + val(3) = 165._RPP/512._RPP ! stencil 3 + val(4) = 55._RPP/1024._RPP ! stencil 4 + val(5) = 1._RPP/1024._RPP ! stencil 5 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/1024._RPP ! stencil 0 - val(2, 1) = 55._RPP/1024._RPP ! stencil 1 - val(2, 2) = 165._RPP/512._RPP ! stencil 2 - val(2, 3) = 231._RPP/512._RPP ! stencil 3 - val(2, 4) = 165._RPP/1024._RPP ! stencil 4 - val(2, 5) = 11._RPP/1024._RPP ! stencil 5 + val(0) = 1._RPP/1024._RPP ! stencil 0 + val(1) = 55._RPP/1024._RPP ! stencil 1 + val(2) = 165._RPP/512._RPP ! stencil 2 + val(3) = 231._RPP/512._RPP ! stencil 3 + val(4) = 165._RPP/1024._RPP ! stencil 4 + val(5) = 11._RPP/1024._RPP ! stencil 5 case(7) ! 13th order ! 1 => left interface (i-1/2) - val(1, 0) = 13._RPP/4096._RPP ! stencil 0 - val(1, 1) = 143._RPP/2048._RPP ! stencil 1 - val(1, 2) = 1287._RPP/4096._RPP ! stencil 2 - val(1, 3) = 429._RPP/1024._RPP ! stencil 3 - val(1, 4) = 179._RPP/1024._RPP ! stencil 4 - val(1, 5) = 39._RPP/2048._RPP ! stencil 5 - val(1, 6) = 1._RPP/4096._RPP ! stencil 6 + val(0) = 13._RPP/4096._RPP ! stencil 0 + val(1) = 143._RPP/2048._RPP ! stencil 1 + val(2) = 1287._RPP/4096._RPP ! stencil 2 + val(3) = 429._RPP/1024._RPP ! stencil 3 + val(4) = 179._RPP/1024._RPP ! stencil 4 + val(5) = 39._RPP/2048._RPP ! stencil 5 + val(6) = 1._RPP/4096._RPP ! stencil 6 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/4096._RPP ! stencil 0 - val(2, 1) = 39._RPP/2048._RPP ! stencil 1 - val(2, 2) = 179._RPP/1024._RPP ! stencil 2 - val(2, 3) = 429._RPP/1024._RPP ! stencil 3 - val(2, 4) = 1287._RPP/4096._RPP ! stencil 4 - val(2, 5) = 143._RPP/2048._RPP ! stencil 5 - val(2, 6) = 13._RPP/4096._RPP ! stencil 6 + val(0) = 1._RPP/4096._RPP ! stencil 0 + val(1) = 39._RPP/2048._RPP ! stencil 1 + val(2) = 179._RPP/1024._RPP ! stencil 2 + val(3) = 429._RPP/1024._RPP ! stencil 3 + val(4) = 1287._RPP/4096._RPP ! stencil 4 + val(5) = 143._RPP/2048._RPP ! stencil 5 + val(6) = 13._RPP/4096._RPP ! stencil 6 case(8) ! 15th order ! 1 => left interface (i-1/2) - val(1, 0) = 15._RPP/16384._RPP ! stencil 0 - val(1, 1) = 455._RPP/16384._RPP ! stencil 1 - val(1, 2) = 3003._RPP/16384._RPP ! stencil 2 - val(1, 3) = 6435._RPP/16384._RPP ! stencil 3 - val(1, 4) = 5005._RPP/16384._RPP ! stencil 4 - val(1, 5) = 1365._RPP/16384._RPP ! stencil 5 - val(1, 6) = 105._RPP/16384._RPP ! stencil 6 - val(1, 7) = 1._RPP/16384._RPP ! stencil 7 + val(0) = 15._RPP/16384._RPP ! stencil 0 + val(1) = 455._RPP/16384._RPP ! stencil 1 + val(2) = 3003._RPP/16384._RPP ! stencil 2 + val(3) = 6435._RPP/16384._RPP ! stencil 3 + val(4) = 5005._RPP/16384._RPP ! stencil 4 + val(5) = 1365._RPP/16384._RPP ! stencil 5 + val(6) = 105._RPP/16384._RPP ! stencil 6 + val(7) = 1._RPP/16384._RPP ! stencil 7 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/16384._RPP ! stencil 0 - val(2, 1) = 105._RPP/16384._RPP ! stencil 1 - val(2, 2) = 1365._RPP/16384._RPP ! stencil 2 - val(2, 3) = 5005._RPP/16384._RPP ! stencil 3 - val(2, 4) = 6435._RPP/16384._RPP ! stencil 4 - val(2, 5) = 3003._RPP/16384._RPP ! stencil 5 - val(2, 6) = 455._RPP/16384._RPP ! stencil 6 - val(2, 7) = 15._RPP/16384._RPP ! stencil 7 + val(0) = 1._RPP/16384._RPP ! stencil 0 + val(1) = 105._RPP/16384._RPP ! stencil 1 + val(2) = 1365._RPP/16384._RPP ! stencil 2 + val(3) = 5005._RPP/16384._RPP ! stencil 3 + val(4) = 6435._RPP/16384._RPP ! stencil 4 + val(5) = 3003._RPP/16384._RPP ! stencil 5 + val(6) = 455._RPP/16384._RPP ! stencil 6 + val(7) = 15._RPP/16384._RPP ! stencil 7 case(9) ! 17th order ! 1 => left interface (i-1/2) - val(1, 0) = 17._RPP/65536._RPP ! stencil 0 - val(1, 1) = 85._RPP/8192._RPP ! stencil 1 - val(1, 2) = 1547._RPP/16384._RPP ! stencil 2 - val(1, 3) = 2431._RPP/8192._RPP ! stencil 3 - val(1, 4) = 12155._RPP/32768._RPP ! stencil 4 - val(1, 5) = 1547._RPP/8192._RPP ! stencil 5 - val(1, 6) = 595._RPP/16384._RPP ! stencil 6 - val(1, 7) = 17._RPP/8192._RPP ! stencil 7 - val(1, 8) = 1._RPP/65536._RPP ! stencil 8 + val(0) = 17._RPP/65536._RPP ! stencil 0 + val(1) = 85._RPP/8192._RPP ! stencil 1 + val(2) = 1547._RPP/16384._RPP ! stencil 2 + val(3) = 2431._RPP/8192._RPP ! stencil 3 + val(4) = 12155._RPP/32768._RPP ! stencil 4 + val(5) = 1547._RPP/8192._RPP ! stencil 5 + val(6) = 595._RPP/16384._RPP ! stencil 6 + val(7) = 17._RPP/8192._RPP ! stencil 7 + val(8) = 1._RPP/65536._RPP ! stencil 8 ! 2 => right interface (i+1/2) - val(2, 0) = 1._RPP/65536._RPP ! stencil 0 - val(2, 1) = 17._RPP/8192._RPP ! stencil 1 - val(2, 2) = 595._RPP/16384._RPP ! stencil 2 - val(2, 3) = 1547._RPP/8192._RPP ! stencil 3 - val(2, 4) = 12155._RPP/32768._RPP ! stencil 4 - val(2, 5) = 2431._RPP/8192._RPP ! stencil 5 - val(2, 6) = 1547._RPP/16384._RPP ! stencil 6 - val(2, 7) = 85._RPP/8192._RPP ! stencil 7 - val(2, 8) = 17._RPP/65536._RPP ! stencil 8 + val(0) = 1._RPP/65536._RPP ! stencil 0 + val(1) = 17._RPP/8192._RPP ! stencil 1 + val(2) = 595._RPP/16384._RPP ! stencil 2 + val(3) = 1547._RPP/8192._RPP ! stencil 3 + val(4) = 12155._RPP/32768._RPP ! stencil 4 + val(5) = 2431._RPP/8192._RPP ! stencil 5 + val(6) = 1547._RPP/16384._RPP ! stencil 6 + val(7) = 85._RPP/8192._RPP ! stencil 7 + val(8) = 17._RPP/65536._RPP ! stencil 8 endselect endassociate - endsubroutine compute + endsubroutine compute_kappa_int + + pure subroutine compute_kappa_rec(self) + !< Compute kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. + + ! Empty subroutine. + endsubroutine compute_kappa_rec pure function description(self) result(string) !< Return string-description of kappa. diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index 20b896c..dda1ca0 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -31,12 +31,14 @@ module wenoof_kappa_rec_js !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 + real(RPP), allocatable :: values(:,:) !< Kappa coefficients values [1:2,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute !< Compute kappa. - procedure, pass(self) :: description !< Return kappa string-description. - procedure, pass(self) :: destroy !< Destroy kappa. + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute_kappa_int !< Compute kappa. + procedure, pass(self) :: compute_kappa_rec !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_rec_js contains @@ -55,7 +57,14 @@ subroutine create(self, constructor) call self%compute endsubroutine create - pure subroutine compute(self) + pure subroutine compute_kappa_int(self) + !< Compute kappa. + class(kappa_rec_js), intent(inout) :: self !< Kappa. + + ! Empty subroutine. + endsubroutine compute_kappa_int + + pure subroutine compute_kappa_rec(self) !< Compute kappa. class(kappa_rec_js), intent(inout) :: self !< Kappa. @@ -175,7 +184,7 @@ pure subroutine compute(self) val(2, 8) = 9._RPP/24310._RPP ! stencil 8 endselect endassociate - endsubroutine compute + endsubroutine compute_kappa_rec pure function description(self) result(string) !< Return string-description of kappa. diff --git a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 index 240cfed..8f2c0f5 100644 --- a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 +++ b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 @@ -67,9 +67,6 @@ pure function description(self) result(string) string = 'Jiang-Shu reconstructor:'//nl string = string//' - S = '//trim(str(self%S))//nl - string = string//' - f1 = '//trim(str(self%f1))//nl - string = string//' - f2 = '//trim(str(self%f2))//nl - string = string//' - ff = '//trim(str(self%ff))//nl string = string//self%weights%description() endfunction description @@ -82,7 +79,18 @@ elemental subroutine destroy(self) if (allocated(self%weights)) deallocate(self%weights) endsubroutine destroy - pure subroutine interpolate_debug(self, stencil, interpolation, si, weights) + pure subroutine interpolate_with_stencil_of_rank_1_debug(self, stencil, interpolation, si, weights) + !< Interpolate values (providing also debug values). + class(reconstructor_js), intent(inout) :: self !< Reconstructor. + real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1-S:-1+S]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation. + real(RPP), intent(out) :: si(0:) !< Computed values of smoothness indicators [0:S-1]. + real(RPP), intent(out) :: weights(0:) !< Weights of the stencils, [0:S-1]. + + ! Empty subroutine. + endsubroutine interpolate_with_stencil_of_rank_1_debug + + pure subroutine interpolate_with_stencil_of_rank_2_debug(self, stencil, interpolation, si, weights) !< Interpolate values (providing also debug values). class(reconstructor_js), intent(inout) :: self !< Reconstructor. real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. @@ -93,9 +101,18 @@ pure subroutine interpolate_debug(self, stencil, interpolation, si, weights) call self%interpolate_standard(stencil=stencil, interpolation=interpolation) si = self%weights%smoothness_indicators() weights = self%weights%values - endsubroutine interpolate_debug + endsubroutine interpolate_with_stencil_of_rank_2_debug + + pure subroutine interpolate_with_stencil_of_rank_1_standard(self, stencil, interpolation) + !< Interpolate values (without providing debug values). + class(reconstructor_js), intent(inout) :: self !< Reconstructor. + real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1-S:-1+S]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation. + + ! Empty subroutine. + endsubroutine interpolate_with_stencil_of_rank_1_standard - pure subroutine interpolate_standard(self, stencil, interpolation) + pure subroutine interpolate_with_stencil_of_rank_2_standard(self, stencil, interpolation) !< Interpolate values (without providing debug values). class(reconstructor_js), intent(inout) :: self !< Reconstructor. real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. @@ -106,10 +123,9 @@ pure subroutine interpolate_standard(self, stencil, interpolation) call self%weights%compute(stencil=stencil) interpolation = 0._RPP do s=0, self%S - 1 ! stencils loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - interpolation(f + self%ff) = interpolation(f + self%ff) + & - self%weights%values(f + self%ff, s) * self%interpolations%values(f, s) + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + interpolation(f) = interpolation(f) + self%weights%values(f, s) * self%interpolations%values(f, s) enddo enddo - endsubroutine interpolate_standard + endsubroutine interpolate_with_stencil_of_rank_2_standard endmodule wenoof_reconstructor_js diff --git a/src/lib/concrete_objects/wenoof_weights_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 similarity index 64% rename from src/lib/concrete_objects/wenoof_weights_js.F90 rename to src/lib/concrete_objects/wenoof_weights_int_js.F90 index cd66b64..0f1cec3 100644 --- a/src/lib/concrete_objects/wenoof_weights_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -1,5 +1,5 @@ !< Jiang-Shu and Gerolymos-Senechal-Vallet weights. -module wenoof_weights_js +module wenoof_weight_int_js !< Jiang-Shu and Gerolymos-Senechal-Vallet weights. !< !< @note The provided WENO weights implements the weights defined in *Efficient Implementation of Weighted ENO @@ -28,40 +28,43 @@ module wenoof_weights_js implicit none private -public :: weights_js -public :: weights_js_constructor +public :: weight_int_js +public :: weight_int_js_constructor -type, extends(weights_object_constructor) :: weights_js_constructor +type, extends(weights_object_constructor) :: weight_int_js_constructor !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal weights object constructor. class(alpha_object_constructor), allocatable :: alpha_constructor !< Alpha coefficients (non linear weights) constructor. class(beta_object_constructor), allocatable :: beta_constructor !< Beta coefficients (smoothness indicators) constructor. class(kappa_object_constructor), allocatable :: kappa_constructor !< kappa coefficients (optimal, linear weights) constructor. -endtype weights_js_constructor +endtype weight_int_js_constructor -type, extends(weights_object):: weights_js +type, extends(weights_object):: weight_int_js !< Jiang-Shu and Gerolymos-Senechal-Vallet weights object. !< !< @note The provided WENO weights implements the weights defined in *Efficient Implementation of Weighted ENO !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 - class(alpha_object), allocatable :: alpha !< Alpha coefficients (non linear weights). - class(beta_object), allocatable :: beta !< Beta coefficients (smoothness indicators). - class(kappa_object), allocatable :: kappa !< kappa coefficients (optimal, linear weights). + real(RPP), allocatable :: values(:) !< Weights values of stencil interpolations [1:2,0:S-1]. + class(alpha_object), allocatable :: alpha !< Alpha coefficients (non linear weights). + class(beta_object), allocatable :: beta !< Beta coefficients (smoothness indicators). + class(kappa_object), allocatable :: kappa !< kappa coefficients (optimal, linear weights). contains ! deferred public methods - procedure, pass(self) :: create !< Create weights. - procedure, pass(self) :: compute !< Compute weights. - procedure, pass(self) :: description !< Return weights string-description. - procedure, pass(self) :: destroy !< Destroy weights. - procedure, pass(self) :: smoothness_indicators !< Return smoothness indicators. -endtype weights_js + procedure, pass(self) :: create !< Create weights. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute weights. + procedure, pass(self) :: compute_with_stencil_of_rank_2 !< Compute weights. + procedure, pass(self) :: description !< Return weights string-description. + procedure, pass(self) :: destroy !< Destroy weights. + procedure, pass(self) :: smoothness_indicators_of_rank_1 !< Return smoothness indicators. + procedure, pass(self) :: smoothness_indicators_of_rank_2 !< Return smoothness indicators. +endtype weight_int_js contains ! deferred public methods subroutine create(self, constructor) !< Create reconstructor. - class(weights_js), intent(inout) :: self !< Weights. + class(weight_int_js), intent(inout) :: self !< Weights. class(base_object_constructor), intent(in) :: constructor !< Constructor. type(alpha_factory) :: a_factory !< Alpha factory. type(beta_factory) :: b_factory !< Beta factory. @@ -72,7 +75,7 @@ subroutine create(self, constructor) allocate(self%values(1:2, 0:self%S - 1)) self%values = 0._RPP select type(constructor) - type is(weights_js_constructor) + type is(weight_int_js_constructor) associate(alpha_constructor=>constructor%alpha_constructor, & beta_constructor=>constructor%beta_constructor, & kappa_constructor=>constructor%kappa_constructor) @@ -104,38 +107,41 @@ subroutine create(self, constructor) endselect endsubroutine create - pure subroutine compute(self, stencil) + pure subroutine compute_with_stencil_of_rank_1(self, stencil) !< Compute weights. - class(weights_js), intent(inout) :: self !< Weights. - real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - integer(I_P) :: f, s !< Counters. + class(weight_int_js), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + integer(I_P) :: s !< Counters. call self%beta%compute(stencil=stencil) call self%alpha%compute(beta=self%beta, kappa=self%kappa) do s=0, self%S - 1 ! stencils loop - do f=self%f1, self%f2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f + self%ff, s) = self%alpha%values(f, s) / self%alpha%values_sum(f) - enddo + self%values(s) = self%alpha%values(s) / self%alpha%values_sum enddo - endsubroutine compute + endsubroutine compute_with_stencil_of_rank_1 + + pure subroutine compute_with_stencil_of_rank_2(self, stencil) + !< Compute weights. + class(weight_int_js), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + + ! Empty routine. + endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) !< Return string-description of weights. - class(weights_js), intent(in) :: self !< Weights. + class(weight_int_js), intent(in) :: self !< Weights. character(len=:), allocatable :: string !< String-description. character(len=1), parameter :: nl=new_line('a') !< New line char. string = ' Jiang-Shu weights:'//nl string = string//' - S = '//trim(str(self%S))//nl - string = string//' - f1 = '//trim(str(self%f1))//nl - string = string//' - f2 = '//trim(str(self%f2))//nl - string = string//' - ff = '//trim(str(self%ff))//nl string = string//self%alpha%description() endfunction description elemental subroutine destroy(self) !< Destroy weights. - class(weights_js), intent(inout) :: self !< Weights. + class(weight_int_js), intent(inout) :: self !< Weights. call self%destroy_ if (allocated(self%values)) deallocate(self%values) @@ -144,15 +150,23 @@ elemental subroutine destroy(self) if (allocated(self%kappa)) deallocate(self%kappa) endsubroutine destroy - pure function smoothness_indicators(self) result(si) + pure function smoothness_indicators_of_rank_1(self) result(si) !< Return smoothness indicators.. - class(weights_js), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:,:) !< Smoothness indicators. + class(weight_int_js), intent(in) :: self !< Weights. + real(RPP), allocatable :: si(:) !< Smoothness indicators. if (allocated(self%beta)) then if (allocated(self%beta%values)) then si = self%beta%values endif endif - endfunction smoothness_indicators -endmodule wenoof_weights_js + endfunction smoothness_indicators_of_rank_1 + + pure function smoothness_indicators_of_rank_2(self) result(si) + !< Return smoothness indicators.. + class(weight_int_js), intent(in) :: self !< Weights. + real(RPP), allocatable :: si(:) !< Smoothness indicators. + + ! Empty routine + endfunction smoothness_indicators_of_rank_2 +endmodule wenoof_weight_int_js diff --git a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 new file mode 100644 index 0000000..8e23612 --- /dev/null +++ b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 @@ -0,0 +1,174 @@ +!< Jiang-Shu and Gerolymos-Senechal-Vallet weights. +module wenoof_weights_rec_js +!< Jiang-Shu and Gerolymos-Senechal-Vallet weights. +!< +!< @note The provided WENO weights implements the weights defined in *Efficient Implementation of Weighted ENO +!< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and +!< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, +!< doi:10.1016/j.jcp.2009.07.039 + +#ifdef r16p +use penf, only: I_P, RPP=>R16P, str +#else +use penf, only: I_P, RPP=>R8P, str +#endif +use wenoof_alpha_factory +use wenoof_alpha_object +use wenoof_alpha_rec_js +use wenoof_alpha_rec_m +use wenoof_alpha_rec_z +use wenoof_base_object +use wenoof_beta_factory +use wenoof_beta_object +use wenoof_beta_rec_js +use wenoof_kappa_factory +use wenoof_kappa_object +use wenoof_kappa_rec_js +use wenoof_weights_object + +implicit none +private +public :: weights_rec_js +public :: weights_rec_js_constructor + +type, extends(weights_object_constructor) :: weights_rec_js_constructor + !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal weights object constructor. + class(alpha_object_constructor), allocatable :: alpha_constructor !< Alpha coefficients (non linear weights) constructor. + class(beta_object_constructor), allocatable :: beta_constructor !< Beta coefficients (smoothness indicators) constructor. + class(kappa_object_constructor), allocatable :: kappa_constructor !< kappa coefficients (optimal, linear weights) constructor. +endtype weights_rec_js_constructor + +type, extends(weights_object):: weights_rec_js + !< Jiang-Shu and Gerolymos-Senechal-Vallet weights object. + !< + !< @note The provided WENO weights implements the weights defined in *Efficient Implementation of Weighted ENO + !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and + !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, + !< doi:10.1016/j.jcp.2009.07.039 + real(RPP), allocatable :: values(:,:) !< Weights values of stencil interpolations [1:2,0:S-1]. + class(alpha_object), allocatable :: alpha !< Alpha coefficients (non linear weights). + class(beta_object), allocatable :: beta !< Beta coefficients (smoothness indicators). + class(kappa_object), allocatable :: kappa !< kappa coefficients (optimal, linear weights). + contains + ! deferred public methods + procedure, pass(self) :: create !< Create weights. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute weights. + procedure, pass(self) :: compute_with_stencil_of_rank_2 !< Compute weights. + procedure, pass(self) :: description !< Return weights string-description. + procedure, pass(self) :: destroy !< Destroy weights. + procedure, pass(self) :: smoothness_indicators_of_rank_1 !< Return smoothness indicators. + procedure, pass(self) :: smoothness_indicators_of_rank_2 !< Return smoothness indicators. +endtype weights_rec_js + +contains + ! deferred public methods + subroutine create(self, constructor) + !< Create reconstructor. + class(weight_rec_js), intent(inout) :: self !< Weights. + class(base_object_constructor), intent(in) :: constructor !< Constructor. + type(alpha_factory) :: a_factory !< Alpha factory. + type(beta_factory) :: b_factory !< Beta factory. + type(kappa_factory) :: k_factory !< Kappa factory. + + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(1:2, 0:self%S - 1)) + self%values = 0._RPP + select type(constructor) + type is(weight_rec_js_constructor) + associate(alpha_constructor=>constructor%alpha_constructor, & + beta_constructor=>constructor%beta_constructor, & + kappa_constructor=>constructor%kappa_constructor) + + call a_factory%create(constructor=alpha_constructor, object=self%alpha) + ! select type(alpha_constructor) + ! type is(alpha_rec_js_constructor) + ! call factory%create(constructor=alpha_constructor, object=self%alpha) + ! type is(alpha_rec_m_constructor) + ! call factory%create(constructor=alpha_constructor, object=self%alpha) + ! type is(alpha_rec_z_constructor) + ! call factory%create(constructor=alpha_constructor, object=self%alpha) + ! endselect + + call b_factory%create(constructor=beta_constructor, object=self%beta) + ! select type(beta_constructor) + ! type is(beta_rec_js_constructor) + ! allocate(beta_rec_js :: self%beta) + ! call self%beta%create(constructor=beta_constructor) + ! endselect + + call k_factory%create(constructor=kappa_constructor, object=self%kappa) + ! select type(kappa_constructor) + ! type is(kappa_rec_js_constructor) + ! allocate(kappa_rec_js :: self%kappa) + ! call self%kappa%create(constructor=kappa_constructor) + ! endselect + endassociate + endselect + endsubroutine create + + pure subroutine compute_with_stencil_of_rank_1(self, stencil) + !< Compute weights. + class(weight_rec_js), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + + ! Empty routine. + endsubroutine compute_with_stencil_of_rank_1 + + pure subroutine compute_with_stencil_of_rank_2(self, stencil) + !< Compute weights. + class(weight_rec_js), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + integer(I_P) :: f, s !< Counters. + + call self%beta%compute(stencil=stencil) + call self%alpha%compute(beta=self%beta, kappa=self%kappa) + do s=0, self%S - 1 ! stencils loop + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + self%values(f, s) = self%alpha%values(f, s) / self%alpha%values_sum(f) + enddo + enddo + endsubroutine compute_with_stencil_of_rank_2 + + pure function description(self) result(string) + !< Return string-description of weights. + class(weight_rec_js), intent(in) :: self !< Weights. + character(len=:), allocatable :: string !< String-description. + character(len=1), parameter :: nl=new_line('a') !< New line char. + + string = ' Jiang-Shu weights:'//nl + string = string//' - S = '//trim(str(self%S))//nl + string = string//self%alpha%description() + endfunction description + + elemental subroutine destroy(self) + !< Destroy weights. + class(weight_rec_js), intent(inout) :: self !< Weights. + + call self%destroy_ + if (allocated(self%values)) deallocate(self%values) + if (allocated(self%alpha)) deallocate(self%alpha) + if (allocated(self%beta)) deallocate(self%beta) + if (allocated(self%kappa)) deallocate(self%kappa) + endsubroutine destroy + + pure function smoothness_indicators_of_rank_1(self) result(si) + !< Return smoothness indicators.. + class(weight_rec_js), intent(in) :: self !< Weights. + real(RPP), allocatable :: si(:) !< Smoothness indicators. + + ! Empty routine + endfunction smoothness_indicators_of_rank_1 + + pure function smoothness_indicators_of_rank_2(self) result(si) + !< Return smoothness indicators.. + class(weight_rec_js), intent(in) :: self !< Weights. + real(RPP), allocatable :: si(:,:) !< Smoothness indicators. + + if (allocated(self%beta)) then + if (allocated(self%beta%values)) then + si = self%beta%values + endif + endif + endfunction smoothness_indicators_of_rank_2 +endmodule wenoof_weights_rec_js diff --git a/src/lib/factories/wenoof_alpha_factory.f90 b/src/lib/factories/wenoof_alpha_factory.f90 index 9c12e75..c6dceb6 100644 --- a/src/lib/factories/wenoof_alpha_factory.f90 +++ b/src/lib/factories/wenoof_alpha_factory.f90 @@ -11,6 +11,9 @@ module wenoof_alpha_factory use wenoof_alpha_rec_js use wenoof_alpha_rec_m use wenoof_alpha_rec_z +use wenoof_alpha_int_js +use wenoof_alpha_int_m +use wenoof_alpha_int_z implicit none private @@ -31,6 +34,12 @@ subroutine create(constructor, object) class(alpha_object), allocatable, intent(out) :: object !< Object. select type(constructor) + type is(alpha_int_js_constructor) + allocate(alpha_int_js :: object) + type is(alpha_int_m_constructor) + allocate(alpha_int_m :: object) + type is(alpha_int_z_constructor) + allocate(alpha_int_z :: object) type is(alpha_rec_js_constructor) allocate(alpha_rec_js :: object) type is(alpha_rec_m_constructor) @@ -43,32 +52,30 @@ subroutine create(constructor, object) call object%create(constructor=constructor) endsubroutine create - subroutine create_constructor(interpolator_type, S, constructor, face_left, face_right, eps) + subroutine create_constructor(interpolator_type, S, constructor, eps) !< Create an instance of concrete extension of [[alpha_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(alpha_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero/division. select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - allocate(alpha_rec_js_constructor :: constructor) + allocate(alpha_int_js_constructor :: constructor) case('interpolator-M-JS') - allocate(alpha_rec_m_constructor :: constructor) + allocate(alpha_int_m_constructor :: constructor) select type(constructor) - type is(alpha_rec_m_constructor) + type is(alpha_int_m_constructor) constructor%base_type = 'JS' endselect case('interpolator-M-Z') - allocate(alpha_rec_m_constructor :: constructor) + allocate(alpha_int_m_constructor :: constructor) select type(constructor) - type is(alpha_rec_m_constructor) + type is(alpha_int_m_constructor) constructor%base_type = 'Z' endselect case('interpolator-Z') - allocate(alpha_rec_z_constructor :: constructor) + allocate(alpha_int_z_constructor :: constructor) case('reconstructor-JS') allocate(alpha_rec_js_constructor :: constructor) case('reconstructor-M-JS') @@ -86,6 +93,6 @@ subroutine create_constructor(interpolator_type, S, constructor, face_left, face case('reconstructor-Z') allocate(alpha_rec_z_constructor :: constructor) endselect - call constructor%create(S=S, face_left=face_left, face_right=face_right, eps=eps) + call constructor%create(S=S, eps=eps) endsubroutine create_constructor endmodule wenoof_alpha_factory diff --git a/src/lib/factories/wenoof_beta_factory.f90 b/src/lib/factories/wenoof_beta_factory.f90 index ab1c213..bbd399d 100644 --- a/src/lib/factories/wenoof_beta_factory.f90 +++ b/src/lib/factories/wenoof_beta_factory.f90 @@ -36,13 +36,11 @@ subroutine create(constructor, object) call object%create(constructor=constructor) endsubroutine create - subroutine create_constructor(interpolator_type, S, constructor, face_left, face_right) + subroutine create_constructor(interpolator_type, S, constructor) !< Create an instance of concrete extension of [[beta_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(beta_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. select case(trim(adjustl(interpolator_type))) case('interpolator-JS') @@ -62,6 +60,6 @@ subroutine create_constructor(interpolator_type, S, constructor, face_left, face case('reconstructor-Z') allocate(beta_rec_js_constructor :: constructor) endselect - call constructor%create(S=S, face_left=face_left, face_right=face_right) + call constructor%create(S=S) endsubroutine create_constructor endmodule wenoof_beta_factory diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index de0228a..d935487 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -36,13 +36,11 @@ subroutine create(constructor, object) call object%create(constructor=constructor) endsubroutine create - subroutine create_constructor(interpolator_type, S, constructor, face_left, face_right) + subroutine create_constructor(interpolator_type, S, constructor) !< Create an instance of concrete extension of [[beta_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interp. - logical, intent(in), optional :: face_right !< Activate right-face interp. select case(trim(adjustl(interpolator_type))) case('interpolator-JS') @@ -56,6 +54,6 @@ subroutine create_constructor(interpolator_type, S, constructor, face_left, face case('reconstructor-Z') allocate(interpolations_rec_js_constructor :: constructor) endselect - call constructor%create(S=S, face_left=face_left, face_right=face_right) + call constructor%create(S=S) endsubroutine create_constructor endmodule wenoof_interpolations_factory diff --git a/src/lib/factories/wenoof_interpolator_factory.f90 b/src/lib/factories/wenoof_interpolator_factory.f90 index 1979d84..7e66558 100644 --- a/src/lib/factories/wenoof_interpolator_factory.f90 +++ b/src/lib/factories/wenoof_interpolator_factory.f90 @@ -39,15 +39,13 @@ subroutine create(constructor, object) endsubroutine create subroutine create_constructor(interpolator_type, S, interpolations_constructor, weights_constructor, & - constructor, face_left, face_right) + constructor) !< Create an instance of concrete extension of [[weights_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(interpolations_object_constructor), intent(in) :: interpolations_constructor !< Interpolations const. class(weights_object_constructor), intent(in) :: weights_constructor !< Weights constructor. class(interpolator_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left interp. - logical, intent(in), optional :: face_right !< Activate right interp. select case(trim(adjustl(interpolator_type))) case('interpolator-JS') @@ -67,7 +65,7 @@ subroutine create_constructor(interpolator_type, S, interpolations_constructor, case('reconstructor-Z') allocate(reconstructor_js_constructor :: constructor) endselect - call constructor%create(S=S, face_left=face_left, face_right=face_right) + call constructor%create(S=S) select type(constructor) type is(interpolator_js_constructor) allocate(constructor%interpolations_constructor, source=interpolations_constructor) diff --git a/src/lib/factories/wenoof_objects_factory.f90 b/src/lib/factories/wenoof_objects_factory.f90 index b0ac17e..e20b8a8 100644 --- a/src/lib/factories/wenoof_objects_factory.f90 +++ b/src/lib/factories/wenoof_objects_factory.f90 @@ -101,14 +101,12 @@ subroutine create_interpolations_object(constructor, object) call factory%create(constructor=constructor, object=object) endsubroutine create_interpolations_object - subroutine create_interpolator(self, interpolator_type, S, interpolator, face_left, face_right, eps) + subroutine create_interpolator(self, interpolator_type, S, interpolator, eps) !< Create an instance of concrete extension of [[interpolator_object]] given user options. class(objects_factory), intent(in) :: self !< The factory. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(interpolator_object), allocatable, intent(out) :: interpolator !< Interpolator. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero/div. class(alpha_object_constructor), allocatable :: alpha_constructor !< Alpha constructor. class(beta_object_constructor), allocatable :: beta_constructor !< Beta constructor. @@ -120,15 +118,11 @@ subroutine create_interpolator(self, interpolator_type, S, interpolator, face_le call self%create_constructor(interpolator_type=interpolator_type, & S=S, & constructor=alpha_constructor, & - face_left=face_left, & - face_right=face_right, & eps=eps) call self%create_constructor(interpolator_type=interpolator_type, & S=S, & - constructor=beta_constructor, & - face_left=face_left, & - face_right=face_right) + constructor=beta_constructor) call self%create_constructor(interpolator_type=interpolator_type, S=S, constructor=kappa_constructor) @@ -137,23 +131,17 @@ subroutine create_interpolator(self, interpolator_type, S, interpolator, face_le alpha_constructor=alpha_constructor, & beta_constructor=beta_constructor, & kappa_constructor=kappa_constructor, & - constructor=weights_constructor, & - face_left=face_left, & - face_right=face_right) + constructor=weights_constructor) call self%create_constructor(interpolator_type=interpolator_type, & S=S, & - constructor=interpolations_constructor, & - face_left=face_left, & - face_right=face_right) + constructor=interpolations_constructor) call self%create_constructor(interpolator_type=interpolator_type, & S=S, & interpolations_constructor=interpolations_constructor, & weights_constructor=weights_constructor, & - constructor=interpolator_constructor, & - face_left=face_left, & - face_right=face_right) + constructor=interpolator_constructor) call self%create_interpolator_object(constructor=interpolator_constructor, object=interpolator) endsubroutine create_interpolator @@ -176,38 +164,30 @@ subroutine create_weights_object(constructor, object) call factory%create(constructor=constructor, object=object) endsubroutine create_weights_object - subroutine create_alpha_object_constructor(interpolator_type, S, constructor, face_left, face_right, eps) + subroutine create_alpha_object_constructor(interpolator_type, S, constructor, eps) !< Create an instance of concrete extension of [[alpha_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(alpha_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero/division. type(alpha_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & S=S, & constructor=constructor, & - face_left=face_left, & - face_right=face_right, & eps=eps) endsubroutine create_alpha_object_constructor - subroutine create_beta_object_constructor(interpolator_type, S, constructor, face_left, face_right) + subroutine create_beta_object_constructor(interpolator_type, S, constructor) !< Create an instance of concrete extension of [[beta_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(beta_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. type(beta_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & S=S, & - constructor=constructor, & - face_left=face_left, & - face_right=face_right) + constructor=constructor) endsubroutine create_beta_object_constructor subroutine create_kappa_object_constructor(interpolator_type, S, constructor) @@ -220,45 +200,37 @@ subroutine create_kappa_object_constructor(interpolator_type, S, constructor) call factory%create_constructor(interpolator_type=interpolator_type, S=S, constructor=constructor) endsubroutine create_kappa_object_constructor - subroutine create_interpolations_object_constructor(interpolator_type, S, constructor, face_left, face_right) + subroutine create_interpolations_object_constructor(interpolator_type, S, constructor) !< Create an instance of concrete extension of [[interpolations_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interp. - logical, intent(in), optional :: face_right !< Activate right-face interp. type(interpolations_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & S=S, & - constructor=constructor, & - face_left=face_left, & - face_right=face_right) + constructor=constructor) endsubroutine create_interpolations_object_constructor subroutine create_interpolator_object_constructor(interpolator_type, S, interpolations_constructor, weights_constructor, & - constructor, face_left, face_right) + constructor) !< Create an instance of concrete extension of [[interpolator_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(interpolations_object_constructor), intent(in) :: interpolations_constructor !< Interpolations const. class(weights_object_constructor), intent(in) :: weights_constructor !< Weights constructor. class(interpolator_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left interp. - logical, intent(in), optional :: face_right !< Activate right interp. type(interpolator_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & S=S, & interpolations_constructor=interpolations_constructor, & weights_constructor=weights_constructor, & - constructor=constructor, & - face_left=face_left, & - face_right=face_right) + constructor=constructor) endsubroutine create_interpolator_object_constructor subroutine create_weights_object_constructor(interpolator_type, S, alpha_constructor, beta_constructor, kappa_constructor, & - constructor, face_left, face_right) + constructor) !< Create an instance of concrete extension of [[weights_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. @@ -266,8 +238,6 @@ subroutine create_weights_object_constructor(interpolator_type, S, alpha_constru class(beta_object_constructor), intent(in) :: beta_constructor !< Beta constructor. class(kappa_object_constructor), intent(in) :: kappa_constructor !< kappa constructor. class(weights_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interp. - logical, intent(in), optional :: face_right !< Activate right-face interp. type(weights_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & @@ -275,8 +245,6 @@ subroutine create_weights_object_constructor(interpolator_type, S, alpha_constru alpha_constructor=alpha_constructor, & beta_constructor=beta_constructor, & kappa_constructor=kappa_constructor, & - constructor=constructor, & - face_left=face_left, & - face_right=face_right) + constructor=constructor) endsubroutine create_weights_object_constructor endmodule wenoof_objects_factory diff --git a/src/lib/factories/wenoof_weights_factory.f90 b/src/lib/factories/wenoof_weights_factory.f90 index 21911c3..e60c751 100644 --- a/src/lib/factories/wenoof_weights_factory.f90 +++ b/src/lib/factories/wenoof_weights_factory.f90 @@ -7,7 +7,8 @@ module wenoof_weights_factory use wenoof_beta_object use wenoof_kappa_object use wenoof_weights_object -use wenoof_weights_js +use wenoof_weights_int_js +use wenoof_weights_rec_js implicit none private @@ -28,8 +29,10 @@ subroutine create(constructor, object) class(weights_object), allocatable, intent(out) :: object !< Object. select type(constructor) - type is(weights_js_constructor) - allocate(weights_js :: object) + type is(weights_int_js_constructor) + allocate(weights_int_js :: object) + type is(weights_rec_js_constructor) + allocate(weights_rec_js :: object) class default error stop 'error: WenOOF object factory do NOT know the constructor given' endselect @@ -37,7 +40,7 @@ subroutine create(constructor, object) endsubroutine create subroutine create_constructor(interpolator_type, S, alpha_constructor, beta_constructor, kappa_constructor, & - constructor, face_left, face_right) + constructor) !< Create an instance of concrete extension of [[weights_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. @@ -45,28 +48,26 @@ subroutine create_constructor(interpolator_type, S, alpha_constructor, beta_cons class(beta_object_constructor), intent(in) :: beta_constructor !< Beta constructor. class(kappa_object_constructor), intent(in) :: kappa_constructor !< kappa constructor. class(weights_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. select case(trim(adjustl(interpolator_type))) case('interpolator-JS') - allocate(weights_js_constructor :: constructor) + allocate(weights_int_js_constructor :: constructor) case('interpolator-M-JS') - allocate(weights_js_constructor :: constructor) + allocate(weights_int_js_constructor :: constructor) case('interpolator-M-Z') - allocate(weights_js_constructor :: constructor) + allocate(weights_int_js_constructor :: constructor) case('interpolator-Z') - allocate(weights_js_constructor :: constructor) + allocate(weights_int_js_constructor :: constructor) case('reconstructor-JS') - allocate(weights_js_constructor :: constructor) + allocate(weights_rec_js_constructor :: constructor) case('reconstructor-M-JS') - allocate(weights_js_constructor :: constructor) + allocate(weights_rec_js_constructor :: constructor) case('reconstructor-M-Z') - allocate(weights_js_constructor :: constructor) + allocate(weights_rec_js_constructor :: constructor) case('reconstructor-Z') - allocate(weights_js_constructor :: constructor) + allocate(weights_rec_js_constructor :: constructor) endselect - call constructor%create(S=S, face_left=face_left, face_right=face_right) + call constructor%create(S=S) select type(constructor) type is(weights_js_constructor) allocate(constructor%alpha_constructor, source=alpha_constructor) diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index 9a75e80..ba8c506 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -16,21 +16,17 @@ module wenoof public :: wenoof_create contains - subroutine wenoof_create(interpolator_type, S, interpolator, face_left, face_right, eps) + subroutine wenoof_create(interpolator_type, S, interpolator, eps) !< WenOOF creator, create a concrete WENO interpolator object. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencil dimension. class(interpolator_object), allocatable, intent(out) :: interpolator !< The concrete WENO interpolator. - logical, intent(in), optional :: face_left !< Activate left-face interpolations. - logical, intent(in), optional :: face_right !< Activate right-face interpolations. real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero-div. type(objects_factory) :: factory !< The factory. call factory%create(interpolator_type=interpolator_type, & S=S, & interpolator=interpolator, & - face_left=face_left, & - face_right=face_right, & eps=eps) endsubroutine wenoof_create endmodule wenoof From ca9f4942393f99e9585f79ce9b63388a1f15ddb4 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 24 Feb 2017 19:29:51 +0100 Subject: [PATCH 20/90] Removed kappa compute routine Short description Why: The compute routine for kappa obkects is unnecessary This change addresses the need by: * Side effects: * --- .../abstract_objects/wenoof_kappa_object.F90 | 20 ------------------- .../concrete_objects/wenoof_kappa_int_js.F90 | 18 +---------------- .../concrete_objects/wenoof_kappa_rec_js.F90 | 16 +-------------- 3 files changed, 2 insertions(+), 52 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index 3742401..7ce346d 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -21,26 +21,6 @@ module wenoof_kappa_object type, extends(base_object), abstract :: kappa_object !< Kappa (optimal, linear weights of stencil interpolations) object. contains - ! public methods - generic :: compute => compute_kappa_int, compute_kappa_rec - ! deferred public methods - procedure(compute_kappa_int_interface), pass(self), deferred :: compute_kappa_int!< Compute beta. - procedure(compute_kappa_rec_interface), pass(self), deferred :: compute_kappa_rec!< Compute beta. endtype kappa_object -abstract interface - !< Abstract interfaces of [[kappa_object]]. - pure subroutine compute_kappa_int_interface(self) - !< Compute kappa. - import :: kappa_object - class(kappa_object), intent(inout) :: self !< Kappa. - endsubroutine compute_kappa_int_interface - - pure subroutine compute_kappa_rec_interface(self) - !< Compute kappa. - import :: kappa_object - class(kappa_object), intent(inout) :: self !< Kappa. - endsubroutine compute_kappa_rec_interface -endinterface - endmodule wenoof_kappa_object diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 4c712f4..78a5cfd 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -33,8 +33,6 @@ module wenoof_kappa_int_js contains ! public deferred methods procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute_kappa_int !< Compute kappa. - procedure, pass(self) :: compute_kappa_rec !< Compute kappa. procedure, pass(self) :: description !< Return kappa string-description. procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_int_js @@ -52,13 +50,6 @@ subroutine create(self, constructor) call self%create_(constructor=constructor) allocate(self%values(0:self%S - 1)) self%values = 0._RPP - call self%compute - endsubroutine create - - pure subroutine compute_kappa_int(self) - !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. - associate(val => self%values) select case(self%S) case(2) ! 3rd order @@ -175,14 +166,7 @@ pure subroutine compute_kappa_int(self) val(8) = 17._RPP/65536._RPP ! stencil 8 endselect endassociate - endsubroutine compute_kappa_int - - pure subroutine compute_kappa_rec(self) - !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. - - ! Empty subroutine. - endsubroutine compute_kappa_rec + endsubroutine create pure function description(self) result(string) !< Return string-description of kappa. diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index dda1ca0..1eec885 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -54,20 +54,6 @@ subroutine create(self, constructor) call self%create_(constructor=constructor) allocate(self%values(1:2, 0:self%S - 1)) self%values = 0._RPP - call self%compute - endsubroutine create - - pure subroutine compute_kappa_int(self) - !< Compute kappa. - class(kappa_rec_js), intent(inout) :: self !< Kappa. - - ! Empty subroutine. - endsubroutine compute_kappa_int - - pure subroutine compute_kappa_rec(self) - !< Compute kappa. - class(kappa_rec_js), intent(inout) :: self !< Kappa. - associate(val => self%values) select case(self%S) case(2) ! 3rd order @@ -184,7 +170,7 @@ pure subroutine compute_kappa_rec(self) val(2, 8) = 9._RPP/24310._RPP ! stencil 8 endselect endassociate - endsubroutine compute_kappa_rec + endsubroutine create pure function description(self) result(string) !< Return string-description of kappa. From bfc9d8f62bbf8502d5930ea236ae3192ead7685a Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Sat, 25 Feb 2017 10:30:01 +0100 Subject: [PATCH 21/90] Revert "Removed kappa compute routine" This reverts commit ca9f4942393f99e9585f79ce9b63388a1f15ddb4. --- .../abstract_objects/wenoof_kappa_object.F90 | 20 +++++++++++++++++++ .../concrete_objects/wenoof_kappa_int_js.F90 | 18 ++++++++++++++++- .../concrete_objects/wenoof_kappa_rec_js.F90 | 16 ++++++++++++++- 3 files changed, 52 insertions(+), 2 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index 7ce346d..3742401 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -21,6 +21,26 @@ module wenoof_kappa_object type, extends(base_object), abstract :: kappa_object !< Kappa (optimal, linear weights of stencil interpolations) object. contains + ! public methods + generic :: compute => compute_kappa_int, compute_kappa_rec + ! deferred public methods + procedure(compute_kappa_int_interface), pass(self), deferred :: compute_kappa_int!< Compute beta. + procedure(compute_kappa_rec_interface), pass(self), deferred :: compute_kappa_rec!< Compute beta. endtype kappa_object +abstract interface + !< Abstract interfaces of [[kappa_object]]. + pure subroutine compute_kappa_int_interface(self) + !< Compute kappa. + import :: kappa_object + class(kappa_object), intent(inout) :: self !< Kappa. + endsubroutine compute_kappa_int_interface + + pure subroutine compute_kappa_rec_interface(self) + !< Compute kappa. + import :: kappa_object + class(kappa_object), intent(inout) :: self !< Kappa. + endsubroutine compute_kappa_rec_interface +endinterface + endmodule wenoof_kappa_object diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 78a5cfd..4c712f4 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -33,6 +33,8 @@ module wenoof_kappa_int_js contains ! public deferred methods procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute_kappa_int !< Compute kappa. + procedure, pass(self) :: compute_kappa_rec !< Compute kappa. procedure, pass(self) :: description !< Return kappa string-description. procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_int_js @@ -50,6 +52,13 @@ subroutine create(self, constructor) call self%create_(constructor=constructor) allocate(self%values(0:self%S - 1)) self%values = 0._RPP + call self%compute + endsubroutine create + + pure subroutine compute_kappa_int(self) + !< Compute kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. + associate(val => self%values) select case(self%S) case(2) ! 3rd order @@ -166,7 +175,14 @@ subroutine create(self, constructor) val(8) = 17._RPP/65536._RPP ! stencil 8 endselect endassociate - endsubroutine create + endsubroutine compute_kappa_int + + pure subroutine compute_kappa_rec(self) + !< Compute kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. + + ! Empty subroutine. + endsubroutine compute_kappa_rec pure function description(self) result(string) !< Return string-description of kappa. diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index 1eec885..dda1ca0 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -54,6 +54,20 @@ subroutine create(self, constructor) call self%create_(constructor=constructor) allocate(self%values(1:2, 0:self%S - 1)) self%values = 0._RPP + call self%compute + endsubroutine create + + pure subroutine compute_kappa_int(self) + !< Compute kappa. + class(kappa_rec_js), intent(inout) :: self !< Kappa. + + ! Empty subroutine. + endsubroutine compute_kappa_int + + pure subroutine compute_kappa_rec(self) + !< Compute kappa. + class(kappa_rec_js), intent(inout) :: self !< Kappa. + associate(val => self%values) select case(self%S) case(2) ! 3rd order @@ -170,7 +184,7 @@ subroutine create(self, constructor) val(2, 8) = 9._RPP/24310._RPP ! stencil 8 endselect endassociate - endsubroutine create + endsubroutine compute_kappa_rec pure function description(self) result(string) !< Return string-description of kappa. From 82f31d856b5f6ddb1daae1463ba1afbfc4fd8d16 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Sat, 25 Feb 2017 11:03:33 +0100 Subject: [PATCH 22/90] New kappa abstract objects Short description Why: * This change addresses the need by: * Side effects: * --- .../abstract_objects/wenoof_alpha_object.F90 | 20 +++--------- .../abstract_objects/wenoof_kappa_object.F90 | 19 ++++-------- .../concrete_objects/wenoof_alpha_int_js.F90 | 20 +++--------- .../concrete_objects/wenoof_alpha_int_m.F90 | 28 ++++++----------- .../concrete_objects/wenoof_alpha_int_z.F90 | 20 +++--------- .../concrete_objects/wenoof_alpha_rec_js.F90 | 20 +++--------- .../concrete_objects/wenoof_alpha_rec_m.F90 | 30 ++++++------------ .../concrete_objects/wenoof_alpha_rec_z.F90 | 20 +++--------- .../concrete_objects/wenoof_kappa_int_js.F90 | 31 +++++++------------ .../concrete_objects/wenoof_kappa_rec_js.F90 | 30 +++++++----------- 10 files changed, 74 insertions(+), 164 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_alpha_object.F90 b/src/lib/abstract_objects/wenoof_alpha_object.F90 index 1e1d2eb..6a5e07f 100644 --- a/src/lib/abstract_objects/wenoof_alpha_object.F90 +++ b/src/lib/abstract_objects/wenoof_alpha_object.F90 @@ -23,30 +23,20 @@ module wenoof_alpha_object type, extends(base_object), abstract :: alpha_object !< Abstract alpha (non linear weights) object. - ! public methods - generic :: compute => compute_alpha_int, compute_alpha_rec - ! deferred public methods - procedure(compute_alpha_int_interface), pass(self), deferred :: compute_alpha_int!< Compute beta. - procedure(compute_alpha_rec_interface), pass(self), deferred :: compute_alpha_rec!< Compute beta. + contains + ! public deferred methods + procedure(compute_interface), pass(self), deferred :: compute !< Compute alpha. endtype alpha_object abstract interface !< Abstract interfaces of [[alpha_object]]. - pure subroutine compute_alpha_int_interface(self, beta, kappa) - !< Compute alpha. - import :: alpha_object, beta_object, kappa_object - class(alpha_object), intent(inout) :: self !< Alpha. - class(beta_object), intent(in) :: beta !< Beta. - class(kappa_object), intent(in) :: kappa !< Kappa. - endsubroutine compute_alpha_int_interface - - pure subroutine compute_alpha_rec_interface(self, beta, kappa) + pure subroutine compute_interface(self, beta, kappa) !< Compute alpha. import :: alpha_object, beta_object, kappa_object class(alpha_object), intent(inout) :: self !< Alpha. class(beta_object), intent(in) :: beta !< Beta. class(kappa_object), intent(in) :: kappa !< Kappa. - endsubroutine compute_alpha_rec_interface + endsubroutine compute_interface endinterface endmodule wenoof_alpha_object diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index 3742401..0772d15 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -20,27 +20,20 @@ module wenoof_kappa_object type, extends(base_object), abstract :: kappa_object !< Kappa (optimal, linear weights of stencil interpolations) object. + real(RPP), allocatable :: values_rank_1(:) !< Kappa coefficients values [0:S-1]. + real(RPP), allocatable :: values_rank_2(:,:) !< Kappa coefficients values [1:2,0:S-1]. contains - ! public methods - generic :: compute => compute_kappa_int, compute_kappa_rec - ! deferred public methods - procedure(compute_kappa_int_interface), pass(self), deferred :: compute_kappa_int!< Compute beta. - procedure(compute_kappa_rec_interface), pass(self), deferred :: compute_kappa_rec!< Compute beta. + ! public deferred methods + procedure(compute_interface), pass(self), deferred :: compute !< Compute kappa. endtype kappa_object abstract interface !< Abstract interfaces of [[kappa_object]]. - pure subroutine compute_kappa_int_interface(self) + pure subroutine compute_interface(self) !< Compute kappa. import :: kappa_object class(kappa_object), intent(inout) :: self !< Kappa. - endsubroutine compute_kappa_int_interface - - pure subroutine compute_kappa_rec_interface(self) - !< Compute kappa. - import :: kappa_object - class(kappa_object), intent(inout) :: self !< Kappa. - endsubroutine compute_kappa_rec_interface + endsubroutine compute_interface endinterface endmodule wenoof_kappa_object diff --git a/src/lib/concrete_objects/wenoof_alpha_int_js.F90 b/src/lib/concrete_objects/wenoof_alpha_int_js.F90 index 29aeacb..028041b 100644 --- a/src/lib/concrete_objects/wenoof_alpha_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_int_js.F90 @@ -33,11 +33,10 @@ module wenoof_alpha_int_js real(RPP) :: values_sum !< Sum of alpha coefficients. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute_alpha_int !< Compute alpha. - procedure, pass(self) :: compute_alpha_rec !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute => compute_alpha_int !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_int_js contains @@ -63,20 +62,11 @@ pure subroutine compute_alpha_int(self, beta, kappa) self%values_sum = 0._RPP do s1=0, self%S - 1 ! stencil loops - self%values(s1) = kappa%values(s1)/(self%eps + beta%values(s1)) ** self%S + self%values(s1) = kappa%values_rank_1(s1)/(self%eps + beta%values(s1)) ** self%S self%values_sum = self%values_sum + self%values(s1) enddo endsubroutine compute_alpha_int - pure subroutine compute_alpha_rec(self, beta, kappa) - !< Compute alpha. - class(alpha_int_js), intent(inout) :: self !< Alpha coefficient. - class(beta_object), intent(in) :: beta !< Beta coefficients. - class(kappa_object), intent(in) :: kappa !< Kappa coefficients. - - ! Empty subroutine - endsubroutine compute_alpha_rec - pure function description(self) result(string) !< Return alpha string-descripition. class(alpha_int_js), intent(in) :: self !< Alpha coefficient. diff --git a/src/lib/concrete_objects/wenoof_alpha_int_m.F90 b/src/lib/concrete_objects/wenoof_alpha_int_m.F90 index d3897ed..341880a 100644 --- a/src/lib/concrete_objects/wenoof_alpha_int_m.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_int_m.F90 @@ -39,11 +39,10 @@ module wenoof_alpha_int_m class(alpha_object), allocatable :: alpha_base !< Base alpha to be re-mapped. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute_alpha_int !< Compute alpha. - procedure, pass(self) :: compute_alpha_rec !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute => compute_alpha_int !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_int_m contains @@ -89,24 +88,15 @@ pure subroutine compute_alpha_int(self, beta, kappa) call self%alpha_base%compute(beta=beta, kappa=kappa) do s1=0, self%S - 1 ! stencil loops kappa_base = self%alpha_base%values(s1) / self%alpha_base%values_sum - self%values(s1) = & - (kappa_base * (kappa%values(s1) + kappa%values(s1) * kappa%values(s1) - & - 3._RPP * kappa%values(s1) * kappa_base + kappa_base * kappa_base)) / & - (kappa%values(s1) * kappa%values(s1) + kappa_base * & - (1._RPP - 2._RPP * kappa%values(s1))) + self%values(s1) = & + (kappa_base * (kappa%values_rank_1(s1) + kappa%values_rank_1(s1) * kappa%values_rank_1(s1) - & + 3._RPP * kappa%values_rank_1(s1) * kappa_base + kappa_base * kappa_base)) / & + (kappa%values_rank_1(s1) * kappa%values_rank_1(s1) + kappa_base * & + (1._RPP - 2._RPP * kappa%values_rank_1(s1))) self%values_sum = self%values_sum + self%values(s1) enddo endsubroutine compute_alpha_int - pure subroutine compute_alpha_rec(self, beta, kappa) - !< Compute alpha. - class(alpha_int_m), intent(inout) :: self !< Alpha. - class(beta_object), intent(in) :: beta !< Beta. - class(kappa_object), intent(in) :: kappa !< Kappa. - - ! Empty subroutine. - endsubroutine compute_alpha_rec - pure function description(self) result(string) !< Return alpha string-descripition. class(alpha_int_m), intent(in) :: self !< Alpha. diff --git a/src/lib/concrete_objects/wenoof_alpha_int_z.F90 b/src/lib/concrete_objects/wenoof_alpha_int_z.F90 index f10d906..69d20fc 100644 --- a/src/lib/concrete_objects/wenoof_alpha_int_z.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_int_z.F90 @@ -35,11 +35,10 @@ module wenoof_alpha_int_z real(RPP), :: values_sum !< Sum of alpha coefficients. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute_alpha_int !< Compute alpha. - procedure, pass(self) :: compute_alpha_rec !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute => compute_alpha_int !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. enddo endtype alpha_int_z contains @@ -65,21 +64,12 @@ pure subroutine compute_alpha_int(self, beta, kappa) self%values_sum = 0._RPP do s1=0, self%S - 1 ! stencil loops - self%values(s1) = kappa%values(s1) * & + self%values(s1) = kappa%values_rank_1(s1) * & ((1._RPP + (tau(S=self%S, beta=beta%values) / (self%eps + beta%values(s1)))) ** (weno_exp(self%S))) self%values_sum = self%values_sum + self%values(s1) enddo endsubroutine compute_alpha_int - pure subroutine compute_alpha_rec(self, beta, kappa) - !< Compute alpha. - class(alpha_int_z), intent(inout) :: self !< Alpha. - class(beta_object), intent(in) :: beta !< Beta. - class(kappa_object), intent(in) :: kappa !< Kappa. - - ! Empty subroutine. - endsubroutine compute_alpha_rec - pure function description(self) result(string) !< Return alpha string-descripition. class(alpha_int_z), intent(in) :: self !< Alpha coefficients. diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 index 7000bfb..988026b 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 @@ -33,11 +33,10 @@ module wenoof_alpha_rec_js real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute_alpha_int !< Compute alpha. - procedure, pass(self) :: compute_alpha_rec !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute => compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_rec_js contains @@ -55,15 +54,6 @@ subroutine create(self, constructor) self%values_sum = 0._RPP endsubroutine create - pure subroutine compute_alpha_int(self, beta, kappa) - !< Compute alpha. - class(alpha_rec_js), intent(inout) :: self !< Alpha coefficient. - class(beta_object), intent(in) :: beta !< Beta coefficients. - class(kappa_object), intent(in) :: kappa !< Kappa coefficients. - - ! Empty subroutine. - endsubroutine compute_alpha_int - pure subroutine compute_alpha_rec(self, beta, kappa) !< Compute alpha. class(alpha_rec_js), intent(inout) :: self !< Alpha coefficient. @@ -74,7 +64,7 @@ pure subroutine compute_alpha_rec(self, beta, kappa) self%values_sum = 0._RPP do s1=0, self%S - 1 ! stencil loops do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = kappa%values(f, s1)/(self%eps + beta%values(f, s1)) ** self%S + self%values(f, s1) = kappa%values_rank_2(f, s1)/(self%eps + beta%values(f, s1)) ** self%S self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo enddo diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 index 963953a..949ac4f 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 @@ -39,11 +39,10 @@ module wenoof_alpha_rec_m class(alpha_object), allocatable :: alpha_base !< Base alpha to be re-mapped. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute_alpha_int !< Compute alpha. - procedure, pass(self) :: compute_alpha_rec !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute => compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_rec_m contains @@ -78,15 +77,6 @@ subroutine create(self, constructor) endselect endsubroutine create - pure subroutine compute_alpha_int(self, beta, kappa) - !< Compute alpha. - class(alpha_rec_m), intent(inout) :: self !< Alpha coefficient. - class(beta_object), intent(in) :: beta !< Beta coefficients. - class(kappa_object), intent(in) :: kappa !< Kappa coefficients. - - ! Empty subroutine. - endsubroutine compute_alpha_int - pure subroutine compute_alpha_rec(self, beta, kappa) !< Compute alpha. class(alpha_rec_m), intent(inout) :: self !< Alpha. @@ -100,12 +90,12 @@ pure subroutine compute_alpha_rec(self, beta, kappa) do s1=0, self%S - 1 ! stencil loops do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) kappa_base = self%alpha_base%values(f, s1) / self%alpha_base%values_sum(f) - self%values(f, s1) = & - (kappa_base * (kappa%values(f, s1) + kappa%values(f, s1) * kappa%values(f, s1) - & - 3._RPP * kappa%values(f, s1) * kappa_base + kappa_base * & - kappa_base)) / & - (kappa%values(f, s1) * kappa%values(f, s1) + kappa_base * & - (1._RPP - 2._RPP * kappa%values(f, s1))) + self%values(f, s1) = & + (kappa_base * (kappa%values_rank_2(f, s1) + kappa%values_rank_2(f, s1) * kappa%values_rank_2(f, s1) - & + 3._RPP * kappa%values_rank_2(f, s1) * kappa_base + kappa_base * & + kappa_base)) / & + (kappa%values_rank_2(f, s1) * kappa%values_rank_2(f, s1) + kappa_base * & + (1._RPP - 2._RPP * kappa%values_rank_2(f, s1))) self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo enddo diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 index f9f75be..51f61f4 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 @@ -35,11 +35,10 @@ module wenoof_alpha_rec_z real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. contains ! public deferred methods - procedure, pass(self) :: create !< Create alpha. - procedure, pass(self) :: compute_alpha_int !< Compute alpha. - procedure, pass(self) :: compute_alpha_rec !< Compute alpha. - procedure, pass(self) :: description !< Return alpha string-description. - procedure, pass(self) :: destroy !< Destroy alpha. + procedure, pass(self) :: create !< Create alpha. + procedure, pass(self) :: compute => compute_alpha_rec !< Compute alpha. + procedure, pass(self) :: description !< Return alpha string-description. + procedure, pass(self) :: destroy !< Destroy alpha. endtype alpha_rec_z contains ! public deferred methods @@ -56,15 +55,6 @@ subroutine create(self, constructor) self%values_sum = 0._RPP endsubroutine create - pure subroutine compute_alpha_int(self, beta, kappa) - !< Compute alpha. - class(alpha_rec_z), intent(inout) :: self !< Alpha. - class(beta_object), intent(in) :: beta !< Beta. - class(kappa_object), intent(in) :: kappa !< Kappa. - - ! Empty subroutine. - endsubroutine compute_alpha_int - pure subroutine compute_alpha_rec(self, beta, kappa) !< Compute alpha. class(alpha_rec_z), intent(inout) :: self !< Alpha. @@ -75,7 +65,7 @@ pure subroutine compute_alpha_rec(self, beta, kappa) self%values_sum = 0._RPP do s1=0, self%S - 1 ! stencil loops do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = kappa%values(f, s1) * & + self%values(f, s1) = kappa%values_rank_2(f, s1) * & ((1._RPP + (tau(S=self%S, beta=beta%values) / (self%eps + beta%values(f, s1)))) ** (weno_exp(self%S))) self%values_sum(f) = self%values_sum(f) + self%values(f, s1) enddo diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 4c712f4..08fc850 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -29,14 +29,12 @@ module wenoof_kappa_int_js !< @note The provided WENO kappa implements the linear weights defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. - real(RPP), allocatable :: values(:) !< Kappa coefficients values [0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute_kappa_int !< Compute kappa. - procedure, pass(self) :: compute_kappa_rec !< Compute kappa. - procedure, pass(self) :: description !< Return kappa string-description. - procedure, pass(self) :: destroy !< Destroy kappa. + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute => compute_kappa_int !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_int_js contains @@ -48,18 +46,20 @@ subroutine create(self, constructor) class(kappa_int_js), intent(inout) :: self !< Kappa. class(base_object_constructor), intent(in) :: constructor !< Kappa constructor. - call self%destroy - call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP - call self%compute + associate(val => self%values_rank_1) + call self%destroy + call self%create_(constructor=constructor) + allocate(val(0:self%S - 1)) + val = 0._RPP + call self%compute + endassociate endsubroutine create pure subroutine compute_kappa_int(self) !< Compute kappa. class(kappa_int_js), intent(inout) :: self !< Kappa. - associate(val => self%values) + associate(val => self%values_rank_1) select case(self%S) case(2) ! 3rd order ! 1 => left interface (i-1/2) @@ -177,13 +177,6 @@ pure subroutine compute_kappa_int(self) endassociate endsubroutine compute_kappa_int - pure subroutine compute_kappa_rec(self) - !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. - - ! Empty subroutine. - endsubroutine compute_kappa_rec - pure function description(self) result(string) !< Return string-description of kappa. class(kappa_int_js), intent(in) :: self !< Kappa. diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index dda1ca0..8f96b2a 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -34,11 +34,10 @@ module wenoof_kappa_rec_js real(RPP), allocatable :: values(:,:) !< Kappa coefficients values [1:2,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute_kappa_int !< Compute kappa. - procedure, pass(self) :: compute_kappa_rec !< Compute kappa. - procedure, pass(self) :: description !< Return kappa string-description. - procedure, pass(self) :: destroy !< Destroy kappa. + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute => compute_kappa_rec !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_rec_js contains @@ -50,25 +49,20 @@ subroutine create(self, constructor) class(kappa_rec_js), intent(inout) :: self !< Kappa. class(base_object_constructor), intent(in) :: constructor !< Kappa constructor. - call self%destroy - call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - self%values = 0._RPP - call self%compute + associate(val => self%values_rank_2) + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values(1:2, 0:self%S - 1)) + self%values = 0._RPP + call self%compute + endassociate endsubroutine create - pure subroutine compute_kappa_int(self) - !< Compute kappa. - class(kappa_rec_js), intent(inout) :: self !< Kappa. - - ! Empty subroutine. - endsubroutine compute_kappa_int - pure subroutine compute_kappa_rec(self) !< Compute kappa. class(kappa_rec_js), intent(inout) :: self !< Kappa. - associate(val => self%values) + associate(val => self%values_rank_2) select case(self%S) case(2) ! 3rd order ! 1 => left interface (i-1/2) From 333b68f3b1f4a2f3870ed2788356182ff6cdea17 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 09:30:11 +0100 Subject: [PATCH 23/90] Modified all abstract objects *STILL NOT COMPILING* Short description Why: * This change addresses the need by: * Side effects: * --- .gdb_history | 96 +++++++++++++++++++ .../abstract_objects/wenoof_alpha_object.F90 | 4 + .../abstract_objects/wenoof_beta_object.F90 | 2 + .../concrete_objects/wenoof_alpha_int_js.F90 | 24 ++--- .../concrete_objects/wenoof_alpha_int_m.F90 | 34 ++++--- .../concrete_objects/wenoof_alpha_int_z.F90 | 28 +++--- .../concrete_objects/wenoof_alpha_rec_js.F90 | 30 +++--- .../concrete_objects/wenoof_alpha_rec_m.F90 | 24 +++-- .../concrete_objects/wenoof_alpha_rec_z.F90 | 31 +++--- .../concrete_objects/wenoof_beta_int_js.F90 | 31 +++--- .../concrete_objects/wenoof_beta_rec_js.F90 | 32 ++++--- .../wenoof_interpolations_rec_js.F90 | 9 +- .../concrete_objects/wenoof_kappa_int_js.F90 | 14 ++- .../concrete_objects/wenoof_kappa_rec_js.F90 | 14 ++- 14 files changed, 248 insertions(+), 125 deletions(-) create mode 100644 .gdb_history diff --git a/.gdb_history b/.gdb_history new file mode 100644 index 0000000..ce964da --- /dev/null +++ b/.gdb_history @@ -0,0 +1,96 @@ +w +where +q +l +l +w +where +l +l +l1 +l 1 +l +l +l +l +l +l +l +l +l +l +l +l +w +where +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +l +b 332 +r +s +l +l +n +p self%ui%interpolator_type +n +s +l +l +n +n +n +n +n +n +n +n +p eps +n +p S +n +p eps +n +n +p S +n +whatis stencil +n +p pn +n +n +n +n +n +n +n +n +n +n +n +n +n +n +n +w +l +n +q diff --git a/src/lib/abstract_objects/wenoof_alpha_object.F90 b/src/lib/abstract_objects/wenoof_alpha_object.F90 index 6a5e07f..ba3613f 100644 --- a/src/lib/abstract_objects/wenoof_alpha_object.F90 +++ b/src/lib/abstract_objects/wenoof_alpha_object.F90 @@ -23,6 +23,10 @@ module wenoof_alpha_object type, extends(base_object), abstract :: alpha_object !< Abstract alpha (non linear weights) object. + real(RPP), allocatable :: values_rank_1(:) !< Alpha values [0:S-1]. + real(RPP) :: values_sum_rank_1 !< Sum of alpha coefficients. + real(RPP), allocatable :: values_rank_2(:,:) !< Alpha values [1:2,0:S-1]. + real(RPP), allocatable :: values_sum_rank_2(:) !< Sum of alpha coefficients [1:2]. contains ! public deferred methods procedure(compute_interface), pass(self), deferred :: compute !< Compute alpha. diff --git a/src/lib/abstract_objects/wenoof_beta_object.F90 b/src/lib/abstract_objects/wenoof_beta_object.F90 index ccc000c..768207b 100644 --- a/src/lib/abstract_objects/wenoof_beta_object.F90 +++ b/src/lib/abstract_objects/wenoof_beta_object.F90 @@ -20,6 +20,8 @@ module wenoof_beta_object type, extends(base_object), abstract :: beta_object !< Abstract Beta coefficients (smoothness indicators of stencil interpolations) object. + real(RPP), allocatable :: values_rank_1(:) !< Beta values [0:S-1]. + real(RPP), allocatable :: values_rank_2(:,:) !< Beta values [1:2,0:S-1]. contains ! public methods generic :: compute => compute_with_stencil_of_rank_1, compute_with_stencil_of_rank_2 diff --git a/src/lib/concrete_objects/wenoof_alpha_int_js.F90 b/src/lib/concrete_objects/wenoof_alpha_int_js.F90 index 028041b..d59177d 100644 --- a/src/lib/concrete_objects/wenoof_alpha_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_int_js.F90 @@ -29,8 +29,6 @@ module wenoof_alpha_int_js !< !< @note The provided WENO alpha implements the alpha coefficients defined in *Efficient Implementation of Weighted !< ENO Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130. - real(RPP), allocatable :: values(:) !< Alpha coefficients [0:S-1]. - real(RPP) :: values_sum !< Sum of alpha coefficients. contains ! public deferred methods procedure, pass(self) :: create !< Create alpha. @@ -48,9 +46,11 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP - self%values_sum = 0._RPP + allocate(self%values_rank_1(0:self%S - 1)) + associate(val => self%values_rank_1, val_sum => self%values_sum_rank_1) + val = 0._RPP + val_sum = 0._RPP + endassociate endsubroutine create pure subroutine compute_alpha_int(self, beta, kappa) @@ -60,11 +60,13 @@ pure subroutine compute_alpha_int(self, beta, kappa) class(kappa_object), intent(in) :: kappa !< Kappa coefficients. integer(I_P) :: s1 !< Counter. - self%values_sum = 0._RPP - do s1=0, self%S - 1 ! stencil loops - self%values(s1) = kappa%values_rank_1(s1)/(self%eps + beta%values(s1)) ** self%S - self%values_sum = self%values_sum + self%values(s1) - enddo + associate(val => self%values_rank_1, val_sum => self%values_sum_rank_1) + val_sum = 0._RPP + do s1=0, self%S - 1 ! stencil loops + val(s1) = kappa%values_rank_1(s1)/(self%eps + beta%values_rank_1(s1)) ** self%S + val_sum = val_sum + val(s1) + enddo + endassociate endsubroutine compute_alpha_int pure function description(self) result(string) @@ -83,6 +85,6 @@ elemental subroutine destroy(self) class(alpha_int_js), intent(inout) :: self !< Alpha. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) endsubroutine destroy endmodule wenoof_alpha_int_js diff --git a/src/lib/concrete_objects/wenoof_alpha_int_m.F90 b/src/lib/concrete_objects/wenoof_alpha_int_m.F90 index 341880a..40eb910 100644 --- a/src/lib/concrete_objects/wenoof_alpha_int_m.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_int_m.F90 @@ -54,9 +54,11 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP - self%values_sum = 0._RPP + allocate(self%values_rank_1(0:self%S - 1)) + associate(val => self%values_rank_1, val_sum => self%values_sum_rank_1) + val = 0._RPP + val_sum = 0._RPP + endassociate select type(constructor) type is(alpha_int_m_constructor) if (allocated(constructor%base_type)) then @@ -84,17 +86,19 @@ pure subroutine compute_alpha_int(self, beta, kappa) real(RPP) :: kappa_base !< Kappa evaluated from the base alphas. integer(I_P) :: s1 !< Counter. - self%values_sum = 0._RPP - call self%alpha_base%compute(beta=beta, kappa=kappa) - do s1=0, self%S - 1 ! stencil loops - kappa_base = self%alpha_base%values(s1) / self%alpha_base%values_sum - self%values(s1) = & - (kappa_base * (kappa%values_rank_1(s1) + kappa%values_rank_1(s1) * kappa%values_rank_1(s1) - & - 3._RPP * kappa%values_rank_1(s1) * kappa_base + kappa_base * kappa_base)) / & - (kappa%values_rank_1(s1) * kappa%values_rank_1(s1) + kappa_base * & - (1._RPP - 2._RPP * kappa%values_rank_1(s1))) - self%values_sum = self%values_sum + self%values(s1) - enddo + associate(val => self%values_rank_1, val_sum => self%values_sum_rank_1) + val_sum = 0._RPP + call self%alpha_base%compute(beta=beta, kappa=kappa) + do s1=0, self%S - 1 ! stencil loops + kappa_base = self%alpha_base%values_rank_1(s1) / self%alpha_base%values_sum_rank_1 + val(s1) = & + (kappa_base * (kappa%values_rank_1(s1) + kappa%values_rank_1(s1) * kappa%values_rank_1(s1) - & + 3._RPP * kappa%values_rank_1(s1) * kappa_base + kappa_base * kappa_base)) / & + (kappa%values_rank_1(s1) * kappa%values_rank_1(s1) + kappa_base * & + (1._RPP - 2._RPP * kappa%values_rank_1(s1))) + val_sum = val_sum + val(s1) + enddo + endassociate endsubroutine compute_alpha_int pure function description(self) result(string) @@ -121,7 +125,7 @@ elemental subroutine destroy(self) class(alpha_int_m), intent(inout) :: self !< Alpha. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) if (allocated(self%alpha_base)) deallocate(self%alpha_base) endsubroutine destroy endmodule wenoof_alpha_int_m diff --git a/src/lib/concrete_objects/wenoof_alpha_int_z.F90 b/src/lib/concrete_objects/wenoof_alpha_int_z.F90 index 69d20fc..c7c113a 100644 --- a/src/lib/concrete_objects/wenoof_alpha_int_z.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_int_z.F90 @@ -32,14 +32,13 @@ module wenoof_alpha_int_z !< scheme for hyperbolic conservation laws*, Rafael Borges, Monique Carmona, Bruno Costa and Wai Sun Don, JCP, !< 2008, vol. 227, pp. 3191-3211, doi: 10.1016/j.jcp.2007.11.038. real(RPP), allocatable :: values(:) !< Alpha coefficients [0:S-1]. - real(RPP), :: values_sum !< Sum of alpha coefficients. + real(RPP) :: values_sum !< Sum of alpha coefficients. contains ! public deferred methods procedure, pass(self) :: create !< Create alpha. procedure, pass(self) :: compute => compute_alpha_int !< Compute alpha. procedure, pass(self) :: description !< Return alpha string-description. procedure, pass(self) :: destroy !< Destroy alpha. - enddo endtype alpha_int_z contains ! public deferred methods @@ -50,9 +49,11 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP - self%values_sum = 0._RPP + allocate(self%values_rank_1(0:self%S - 1)) + associate(val => self%values_rank_1, val_sum => self%values_sum_rank_1) + val = 0._RPP + val_sum = 0._RPP + endassociate endsubroutine create pure subroutine compute_alpha_int(self, beta, kappa) @@ -62,12 +63,15 @@ pure subroutine compute_alpha_int(self, beta, kappa) class(kappa_object), intent(in) :: kappa !< Kappa. integer(I_P) :: s1 !< Counter. - self%values_sum = 0._RPP - do s1=0, self%S - 1 ! stencil loops - self%values(s1) = kappa%values_rank_1(s1) * & - ((1._RPP + (tau(S=self%S, beta=beta%values) / (self%eps + beta%values(s1)))) ** (weno_exp(self%S))) - self%values_sum = self%values_sum + self%values(s1) - enddo + associate(val => self%values_rank_1, val_sum => self%values_sum_rank_1) + val_sum = 0._RPP + do s1=0, self%S - 1 ! stencil loops + val = kappa%values_rank_1(s1) * & + ((1._RPP + (tau(S=self%S, beta=beta%values_rank_1) / & + (self%eps + beta%values_rank_1(s1)))) ** (weno_exp(self%S))) + val_sum = val_sum + val(s1) + enddo + endassociate endsubroutine compute_alpha_int pure function description(self) result(string) @@ -87,7 +91,7 @@ elemental subroutine destroy(self) class(alpha_int_z), intent(inout) :: self !< Alpha. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) endsubroutine destroy ! private non TBP diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 index 988026b..86f9ec4 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_js.F90 @@ -29,8 +29,6 @@ module wenoof_alpha_rec_js !< !< @note The provided WENO alpha implements the alpha coefficients defined in *Efficient Implementation of Weighted !< ENO Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130. - real(RPP), allocatable :: values(:,:) !< Alpha coefficients [1:2,0:S-1]. - real(RPP), allocatable :: values_sum(:) !< Sum of alpha coefficients [1:2]. contains ! public deferred methods procedure, pass(self) :: create !< Create alpha. @@ -48,10 +46,12 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - allocate(self%values_sum(1:2)) - self%values = 0._RPP - self%values_sum = 0._RPP + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + allocate(self%values_sum_rank_2(1:2)) + associate(val => self%values_rank_2, val_sum => self%values_sum_rank_2) + val = 0._RPP + val_sum = 0._RPP + endassociate endsubroutine create pure subroutine compute_alpha_rec(self, beta, kappa) @@ -61,13 +61,15 @@ pure subroutine compute_alpha_rec(self, beta, kappa) class(kappa_object), intent(in) :: kappa !< Kappa coefficients. integer(I_P) :: f, s1 !< Counters. - self%values_sum = 0._RPP - do s1=0, self%S - 1 ! stencil loops - do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = kappa%values_rank_2(f, s1)/(self%eps + beta%values(f, s1)) ** self%S - self%values_sum(f) = self%values_sum(f) + self%values(f, s1) + associate(val => self%values_rank_2, val_sum => self%values_sum_rank_2) + val_sum = 0._RPP + do s1=0, self%S - 1 ! stencil loops + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + val(f, s1) = kappa%values_rank_2(f, s1)/(self%eps + beta%values_rank_2(f, s1)) ** self%S + val_sum(f) = val_sum(f) + val(f, s1) + enddo enddo - enddo + endassociate endsubroutine compute_alpha_rec pure function description(self) result(string) @@ -86,7 +88,7 @@ elemental subroutine destroy(self) class(alpha_rec_js), intent(inout) :: self !< Alpha. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) - if (allocated(self%values_sum)) deallocate(self%values_sum) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) + if (allocated(self%values_sum_rank_2)) deallocate(self%values_sum_rank_2) endsubroutine destroy endmodule wenoof_alpha_rec_js diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 index 949ac4f..7071b3e 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_m.F90 @@ -54,10 +54,12 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - allocate(self%values_sum(1:2)) - self%values = 0._RPP - self%values_sum = 0._RPP + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + allocate(self%values_sum_rank_2(1:2)) + associate(val => self%values_rank_2, val_sum => self%values_sum_rank_2) + val = 0._RPP + val_sum = 0._RPP + endassociate select type(constructor) type is(alpha_rec_m_constructor) if (allocated(constructor%base_type)) then @@ -85,20 +87,22 @@ pure subroutine compute_alpha_rec(self, beta, kappa) real(RPP) :: kappa_base !< Kappa evaluated from the base alphas. integer(I_P) :: f, s1 !< Counters. - self%values_sum = 0._RPP + associate(val => self%values_rank_2, val_sum => self%values_sum_rank_2) + val_sum = 0._RPP call self%alpha_base%compute(beta=beta, kappa=kappa) do s1=0, self%S - 1 ! stencil loops do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - kappa_base = self%alpha_base%values(f, s1) / self%alpha_base%values_sum(f) - self%values(f, s1) = & + kappa_base = self%alpha_base%values_rank_2(f, s1) / self%alpha_base%values_sum_rank_2(f) + val(f, s1) = & (kappa_base * (kappa%values_rank_2(f, s1) + kappa%values_rank_2(f, s1) * kappa%values_rank_2(f, s1) - & 3._RPP * kappa%values_rank_2(f, s1) * kappa_base + kappa_base * & kappa_base)) / & (kappa%values_rank_2(f, s1) * kappa%values_rank_2(f, s1) + kappa_base * & (1._RPP - 2._RPP * kappa%values_rank_2(f, s1))) - self%values_sum(f) = self%values_sum(f) + self%values(f, s1) + val_sum(f) = val_sum(f) + val(f, s1) enddo enddo + endassociate endsubroutine compute_alpha_rec pure function description(self) result(string) @@ -125,8 +129,8 @@ elemental subroutine destroy(self) class(alpha_rec_m), intent(inout) :: self !< Alpha. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) - if (allocated(self%values_sum)) deallocate(self%values_sum) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) + if (allocated(self%values_sum_rank_2)) deallocate(self%values_sum_rank_2) if (allocated(self%alpha_base)) deallocate(self%alpha_base) endsubroutine destroy endmodule wenoof_alpha_rec_m diff --git a/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 b/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 index 51f61f4..75ca30d 100644 --- a/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 +++ b/src/lib/concrete_objects/wenoof_alpha_rec_z.F90 @@ -49,10 +49,12 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - allocate(self%values_sum(1:2)) - self%values = 0._RPP - self%values_sum = 0._RPP + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + allocate(self%values_sum_rank_2(1:2)) + associate(val => self%values_rank_2, val_sum => self%values_sum_rank_2) + val = 0._RPP + val_sum = 0._RPP + endassociate endsubroutine create pure subroutine compute_alpha_rec(self, beta, kappa) @@ -62,14 +64,17 @@ pure subroutine compute_alpha_rec(self, beta, kappa) class(kappa_object), intent(in) :: kappa !< Kappa. integer(I_P) :: f, s1 !< Counters. - self%values_sum = 0._RPP - do s1=0, self%S - 1 ! stencil loops - do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = kappa%values_rank_2(f, s1) * & - ((1._RPP + (tau(S=self%S, beta=beta%values) / (self%eps + beta%values(f, s1)))) ** (weno_exp(self%S))) - self%values_sum(f) = self%values_sum(f) + self%values(f, s1) + associate(val => self%values_rank_2, val_sum => self%values_sum_rank_2) + val_sum = 0._RPP + do s1=0, self%S - 1 ! stencil loops + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + val(f, s1) = kappa%values_rank_2(f, s1) * & + ((1._RPP + (tau(S=self%S, beta=beta%values_rank_2) / & + (self%eps + beta%values_rank_2(f, s1)))) ** (weno_exp(self%S))) + val_sum(f) = val_sum(f) + val(f, s1) + enddo enddo - enddo + endassociate endsubroutine compute_alpha_rec pure function description(self) result(string) @@ -89,8 +94,8 @@ elemental subroutine destroy(self) class(alpha_rec_z), intent(inout) :: self !< Alpha. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) - if (allocated(self%values_sum)) deallocate(self%values_sum) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) + if (allocated(self%values_sum_rank_2)) deallocate(self%values_sum_rank_2) endsubroutine destroy ! private non TBP diff --git a/src/lib/concrete_objects/wenoof_beta_int_js.F90 b/src/lib/concrete_objects/wenoof_beta_int_js.F90 index ef278c5..6a122ea 100644 --- a/src/lib/concrete_objects/wenoof_beta_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_int_js.F90 @@ -29,16 +29,15 @@ module wenoof_beta_int_js !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. - real(RPP), allocatable :: values(:) !< Beta values [0:S-1]. private real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [0:S-1,0:S-1,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create beta. - procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute beta. - procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute beta. - procedure, pass(self) :: description !< Return beta string-description. - procedure, pass(self) :: destroy !< Destroy beta. + procedure, pass(self) :: create !< Create beta. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute beta. + procedure, pass(self) :: compute_with_stencil_of_rank_2 !< Compute beta. + procedure, pass(self) :: description !< Return beta string-description. + procedure, pass(self) :: destroy !< Destroy beta. endtype beta_int_js contains @@ -50,8 +49,8 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP + allocate(self%values_rank_1(0:self%S - 1)) + self%values_rank_1 = 0._RPP allocate(self%coef(0:self%S - 1, 0:self%S - 1, 0:self%S - 1)) associate(c => self%coef) select case(self%S) @@ -2379,14 +2378,16 @@ pure subroutine compute_with_stencil_of_rank_1(self, stencil) real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. integer(I_P) :: s1, s2, s3 !< Counters. - do s1=0, self%S - 1 ! stencils loop - self%values(f, s1) = 0._RPP - do s2=0, self%S - 1 - do s3=0, self%S - 1 - self%values(s1) = self%values(s1) + self%coef(s3, s2, s1) * stencil(s1 - s3) * stencil(s1 - s2) + associate(val => self%values_rank_1) + do s1=0, self%S - 1 ! stencils loop + val(s1) = 0._RPP + do s2=0, self%S - 1 + do s3=0, self%S - 1 + val(s1) = val(s1) + self%coef(s3, s2, s1) * stencil(s1 - s3) * stencil(s1 - s2) + enddo enddo enddo - enddo + endassociate endsubroutine compute_with_stencil_of_rank_1 pure subroutine compute_with_stencil_of_rank_2(self, stencil) @@ -2413,7 +2414,7 @@ elemental subroutine destroy(self) class(beta_int_js), intent(inout) :: self !< Beta. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) if (allocated(self%coef)) deallocate(self%coef) endsubroutine destroy endmodule wenoof_beta_int_js diff --git a/src/lib/concrete_objects/wenoof_beta_rec_js.F90 b/src/lib/concrete_objects/wenoof_beta_rec_js.F90 index fd88e48..94a34e0 100644 --- a/src/lib/concrete_objects/wenoof_beta_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_rec_js.F90 @@ -31,15 +31,15 @@ module wenoof_beta_rec_js !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 - real(RPP), allocatable :: values(:,:) !< Beta values [1:2,0:S-1]. private real(RPP), allocatable :: coef(:,:,:) !< Beta coefficients [0:S-1,0:S-1,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create beta. - procedure, pass(self) :: compute !< Compute beta. - procedure, pass(self) :: description !< Return beta string-description. - procedure, pass(self) :: destroy !< Destroy beta. + procedure, pass(self) :: create !< Create beta. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute beta. + procedure, pass(self) :: compute_with_stencil_of_rank_2 !< Compute beta. + procedure, pass(self) :: description !< Return beta string-description. + procedure, pass(self) :: destroy !< Destroy beta. endtype beta_rec_js contains @@ -51,8 +51,8 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - self%values = 0._RPP + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + self%values_rank_2 = 0._RPP allocate(self%coef(0:self%S - 1, 0:self%S - 1, 0:self%S - 1)) associate(c => self%coef) select case(self%S) @@ -2388,16 +2388,18 @@ pure subroutine compute_with_stencil_of_rank_2(self, stencil) real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. integer(I_P) :: s1, s2, s3, f !< Counters. - do s1=0, self%S - 1 ! stencils loop - do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = 0._RPP - do s2=0, self%S - 1 - do s3=0, self%S - 1 - self%values(f, s1) = self%values(f, s1) + self%coef(s3, s2, s1) * stencil(f, s1 - s3) * stencil(f, s1 - s2) + associate(val => self%values_rank_2) + do s1=0, self%S - 1 ! stencils loop + do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) + val(f, s1) = 0._RPP + do s2=0, self%S - 1 + do s3=0, self%S - 1 + val(f, s1) = val(f, s1) + self%coef(s3, s2, s1) * stencil(f, s1 - s3) * stencil(f, s1 - s2) + enddo enddo enddo enddo - enddo + endassociate endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) @@ -2416,7 +2418,7 @@ elemental subroutine destroy(self) class(beta_rec_js), intent(inout) :: self !< Beta. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) if (allocated(self%coef)) deallocate(self%coef) endsubroutine destroy endmodule wenoof_beta_rec_js diff --git a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 index 14cc4c0..d9b5777 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 @@ -36,10 +36,11 @@ module wenoof_interpolations_rec_js real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [1:2,0:S-1,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create interpolations. - procedure, pass(self) :: compute !< Compute interpolations. - procedure, pass(self) :: description !< Return interpolations string-description. - procedure, pass(self) :: destroy !< Destroy interpolations. + procedure, pass(self) :: create !< Create interpolations. + procedure, pass(self) :: compute_with_stencil_or_rank_1 !< Compute interpolations. + procedure, pass(self) :: compute_with_stencil_or_rank_2 !< Compute interpolations. + procedure, pass(self) :: description !< Return interpolations string-description. + procedure, pass(self) :: destroy !< Destroy interpolations. endtype interpolations_rec_js contains diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 08fc850..8f066bb 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -46,13 +46,11 @@ subroutine create(self, constructor) class(kappa_int_js), intent(inout) :: self !< Kappa. class(base_object_constructor), intent(in) :: constructor !< Kappa constructor. - associate(val => self%values_rank_1) - call self%destroy - call self%create_(constructor=constructor) - allocate(val(0:self%S - 1)) - val = 0._RPP - call self%compute - endassociate + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values_rank_1(0:self%S - 1)) + self%values_rank_1 = 0._RPP + call self%compute endsubroutine create pure subroutine compute_kappa_int(self) @@ -193,6 +191,6 @@ elemental subroutine destroy(self) class(kappa_int_js), intent(inout) :: self !< Kappa. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) endsubroutine destroy endmodule wenoof_kappa_int_js diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index 8f96b2a..326ce75 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -49,13 +49,11 @@ subroutine create(self, constructor) class(kappa_rec_js), intent(inout) :: self !< Kappa. class(base_object_constructor), intent(in) :: constructor !< Kappa constructor. - associate(val => self%values_rank_2) - call self%destroy - call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - self%values = 0._RPP - call self%compute - endassociate + call self%destroy + call self%create_(constructor=constructor) + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + self%values_rank_2 = 0._RPP + call self%compute endsubroutine create pure subroutine compute_kappa_rec(self) @@ -196,6 +194,6 @@ elemental subroutine destroy(self) class(kappa_rec_js), intent(inout) :: self !< Kappa. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) endsubroutine destroy endmodule wenoof_kappa_rec_js From 6c26aec8bd613b7bef1666e4d49299c51337c456 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 10:06:10 +0100 Subject: [PATCH 24/90] Corrected wrong module name Short description Why: * This change addresses the need by: * Side effects: * --- src/lib/concrete_objects/wenoof_weights_int_js.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 0f1cec3..13c8c2f 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -1,5 +1,5 @@ !< Jiang-Shu and Gerolymos-Senechal-Vallet weights. -module wenoof_weight_int_js +module wenoof_weights_int_js !< Jiang-Shu and Gerolymos-Senechal-Vallet weights. !< !< @note The provided WENO weights implements the weights defined in *Efficient Implementation of Weighted ENO @@ -169,4 +169,4 @@ pure function smoothness_indicators_of_rank_2(self) result(si) ! Empty routine endfunction smoothness_indicators_of_rank_2 -endmodule wenoof_weight_int_js +endmodule wenoof_weights_int_js From 06723d2283409b5f8b0bcc2e40b925bd58717540 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 10:28:10 +0100 Subject: [PATCH 25/90] Delete wrong routine definition. Short description Why: * This change addresses the need by: * Side effects: * --- src/lib/abstract_objects/wenoof_interpolator_object.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/abstract_objects/wenoof_interpolator_object.F90 b/src/lib/abstract_objects/wenoof_interpolator_object.F90 index 75c851e..3623551 100644 --- a/src/lib/abstract_objects/wenoof_interpolator_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolator_object.F90 @@ -44,7 +44,6 @@ module wenoof_interpolator_object procedure(interpolate_with_stencil_of_rank_2_standard_interface), pass(self), & deferred :: interpolate_with_stencil_of_rank_2_standard ! public methods - generic :: interpolate => interpolate_standard, interpolate_debug !< Interpolate values. endtype interpolator_object abstract interface From 99843a95d0ebc4507b66567604e3d8540e9e45f4 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 10:54:17 +0100 Subject: [PATCH 26/90] Fix wrong coeff value Short description Why: * This change addresses the need by: * Side effects: * --- src/lib/concrete_objects/wenoof_beta_int_js.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_beta_int_js.F90 b/src/lib/concrete_objects/wenoof_beta_int_js.F90 index 6a122ea..03db3c5 100644 --- a/src/lib/concrete_objects/wenoof_beta_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_int_js.F90 @@ -335,7 +335,7 @@ subroutine create(self, constructor) c(3,1,2) = 87743770._RPP/ 602579._RPP; c(4,1,2) =-1512485867._RPP/24006092._RPP; c(5,1,2) = 251883319._RPP/23224320._RPP ! / ; / ; i*i - c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 200449727._RPP/ 1269707_RPP + c(0,2,2) = 0._RPP ; c(1,2,2) = 0._RPP ; c(2,2,2) = 200449727._RPP/ 1269707._RPP ! (i-1)*i ; (i-2)*i ; (i-3)*i c(3,2,2) =-274966489._RPP/ 950662._RPP; c(4,2,2) = 201365679._RPP/ 1563055._RPP; c(5,2,2) = -61673356._RPP/ 2721737._RPP From c65483064aaecda4376d43e03b21cf363cac8791 Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Mon, 27 Feb 2017 13:58:13 +0100 Subject: [PATCH 27/90] fix third party recursiveness --- .gitmodules | 4 ++-- fobos | 5 +++-- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/.gitmodules b/.gitmodules index f0fd8b5..14cd88d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -11,6 +11,6 @@ url = https://github.com/szaghi/FLAP branch = master [submodule "src/third_party/FOLLIA"] - path = src/third_party/FOLLIA - url = https://github.com/giacombum/FOLLIA.git + path = src/third_party/FOLLIA + url = https://github.com/giacombum/FOLLIA.git branch = master diff --git a/fobos b/fobos index c4455ae..d6cbb5a 100644 --- a/fobos +++ b/fobos @@ -13,8 +13,9 @@ $CSTATIC_INT = -cpp -c -assume realloc_lhs $DEBUG_GNU = -Og -g3 -Warray-bounds -Wcharacter-truncation -Wline-truncation -Wimplicit-interface -Wimplicit-procedure -Wunderflow -fcheck=all -fmodule-private -ffree-line-length-132 -fimplicit-none -fbacktrace -fdump-core -finit-real=nan -std=f2008 -fall-intrinsics $DEBUG_INT = -O0 -debug all -check all -warn all -extend-source 132 -traceback -gen-interfaces#-fpe-all=0 -fp-stack-check -fstack-protector-all -ftrapuv -no-ftz -std08 $OPTIMIZE = -O2 -$EXDIRS = FLAP/src/tests/ FLAP/src/third_party/ PENF/src/tests/ pyplot-fortran/src/tests/ FOODIE/src/tests/ - +$EXDIRS = FLAP/src/tests/ FLAP/src/third_party/ + PENF/src/tests/ pyplot-fortran/src/tests/ + FOODIE/src/tests/ FOODIE/src/third_party/ # main modes # GNU From 16c442115b214490f614cbe9ddd80ef2bac87502 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 15:29:26 +0100 Subject: [PATCH 28/90] fixed typos *STILL NOT COMPILING* --- .../wenoof_interpolations_object.F90 | 3 +- .../wenoof_weights_object.F90 | 16 +++---- .../wenoof_interpolations_int_js.F90 | 12 ++--- .../wenoof_interpolations_rec_js.F90 | 15 +++--- .../wenoof_interpolator_js.F90 | 2 +- .../wenoof_reconstructor_js.F90 | 3 +- .../wenoof_weights_int_js.F90 | 48 +++++++++---------- .../wenoof_weights_rec_js.F90 | 44 ++++++++--------- 8 files changed, 73 insertions(+), 70 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_interpolations_object.F90 b/src/lib/abstract_objects/wenoof_interpolations_object.F90 index 2ad5935..bf35384 100644 --- a/src/lib/abstract_objects/wenoof_interpolations_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolations_object.F90 @@ -20,7 +20,8 @@ module wenoof_interpolations_object type, extends(base_object), abstract :: interpolations_object !< Abstract interpolations object. - real(RPP), allocatable :: values(:,:) !< Stencil interpolations values [1:2,0:S-1]. + real(RPP), allocatable :: values_rank_1(:) !< Stencil interpolations values [0:S-1]. + real(RPP), allocatable :: values_rank_2(:,:) !< Stencil interpolations values [1:2,0:S-1]. contains ! public methods generic :: compute => compute_with_stencil_of_rank_1, compute_with_stencil_of_rank_2 diff --git a/src/lib/abstract_objects/wenoof_weights_object.F90 b/src/lib/abstract_objects/wenoof_weights_object.F90 index 32c7cec..fd4404c 100644 --- a/src/lib/abstract_objects/wenoof_weights_object.F90 +++ b/src/lib/abstract_objects/wenoof_weights_object.F90 @@ -47,19 +47,19 @@ pure subroutine compute_with_stencil_of_rank_2_interface(self, stencil) real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. endsubroutine compute_with_stencil_of_rank_2_interface - pure function smoothness_indicators_of_rank_1_interface(self) result(si) + pure subroutine smoothness_indicators_of_rank_1_interface(self, si) !< Return smoothness indicators. import :: weights_object, RPP - class(weights_object), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:) !< Smoothness indicators. - endfunction smoothness_indicators_of_rank_1_interface + class(weights_object), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. + endsubroutine smoothness_indicators_of_rank_1_interface - pure function smoothness_indicators_of_rank_2_interface(self) result(si) + pure subroutine smoothness_indicators_of_rank_2_interface(self, si) !< Return smoothness indicators. import :: weights_object, RPP - class(weights_object), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:,:) !< Smoothness indicators. - endfunction smoothness_indicators_of_rank_2_interface + class(weights_object), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. + endsubroutine smoothness_indicators_of_rank_2_interface endinterface endmodule wenoof_weights_object diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index 6b4f182..e37d0a8 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -29,9 +29,8 @@ module wenoof_interpolations_int_js !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. - real(RPP), allocatable :: values(:) !< Interpolations values [0:S-1]. private - real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [0:S-1,0:S-1]. + real(RPP), allocatable :: coef(:,:) !< Polynomial coefficients [0:S-1,0:S-1]. contains ! public deferred methods procedure, pass(self) :: create !< Create interpolations. @@ -50,8 +49,8 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP + allocate(self%values_rank_1(0:self%S - 1)) + self%values_rank_1 = 0._RPP allocate(self%coef(0:self%S - 1, 0:self%S - 1)) associate(c => self%coef) select case(self%S) @@ -328,10 +327,11 @@ pure subroutine compute_with_stencil_of_rank_1(self, stencil) integer(I_P) :: s1 !< Counter. integer(I_P) :: s2 !< Counter. - self%values = 0._RPP + associate(val => self%values_rank_1) + val = 0._RPP do s1=0, self%S - 1 ! stencils loop do s2=0, self%S - 1 ! values loop - self%values(s1) = self%values(s1) + self%coef(s2, s1) * stencil(-s2 + s1) + val(s1) = val(s1) + self%coef(s2, s1) * stencil(-s2 + s1) enddo enddo endsubroutine compute_with_stencil_of_rank_1 diff --git a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 index d9b5777..0974ae7 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 @@ -31,7 +31,6 @@ module wenoof_interpolations_rec_js !< of Weighted ENO Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 - real(RPP), allocatable :: values(:,:) !< Interpolations values [1:2,0:S-1]. private real(RPP), allocatable :: coef(:,:,:) !< Polynomial coefficients [1:2,0:S-1,0:S-1]. contains @@ -52,8 +51,8 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - self%values = 0._RPP + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + self%values_rank_2 = 0._RPP allocate(self%coef(1:2, 0:self%S - 1, 0:self%S - 1)) associate(c => self%coef) select case(self%S) @@ -305,7 +304,7 @@ subroutine create(self, constructor) c(1,4,3)= 533._RPP/ 840._RPP; c(1,4,2)=- 307._RPP/ 840._RPP; c(1,4,1)= 393._RPP/ 840._RPP; c(1,4,0)=-1007._RPP/ 840._RPP c(1,5,3)=- 139._RPP/ 840._RPP; c(1,5,2)= 113._RPP/ 840._RPP; c(1,5,1)=- 167._RPP/ 840._RPP; c(1,5,0)= 463._RPP/ 840._RPP c(1,6,3)= 29._RPP/ 840._RPP; c(1,6,2)=- 27._RPP/ 840._RPP; c(1,6,1)= 43._RPP/ 840._RPP; c(1,6,0)=- 125._RPP/ 840._RPP - c(1,7,3)=- 3._RPP/ 840._RPP; c(1,7,2)= 3._RPP/ 840._RPP; c(1,7,1)=- 5._RPP/ 840._RPP; c(1,7,0)= 15._RPP/ 840 _RPP + c(1,7,3)=- 3._RPP/ 840._RPP; c(1,7,2)= 3._RPP/ 840._RPP; c(1,7,1)=- 5._RPP/ 840._RPP; c(1,7,0)= 15._RPP/ 840._RPP ! 2 => right interface (i+1/2) c(2,7,0)=- 105._RPP/ 840._RPP; c(2,7,1)= 15._RPP/ 840._RPP; c(2,7,2)=- 5._RPP/ 840._RPP; c(2,7,3)= 3._RPP/ 840._RPP c(2,6,0)= 855._RPP/ 840._RPP; c(2,6,1)=- 125._RPP/ 840._RPP; c(2,6,2)= 43._RPP/ 840._RPP; c(2,6,3)=- 27._RPP/ 840._RPP @@ -323,7 +322,7 @@ subroutine create(self, constructor) c(2,3,4)= 533._RPP/ 840._RPP; c(2,3,5)=- 307._RPP/ 840._RPP; c(2,3,6)= 393._RPP/ 840._RPP; c(2,3,7)=-1007._RPP/ 840._RPP c(2,2,4)=- 139._RPP/ 840._RPP; c(2,2,5)= 113._RPP/ 840._RPP; c(2,2,6)=- 167._RPP/ 840._RPP; c(2,2,7)= 463._RPP/ 840._RPP c(2,1,4)= 29._RPP/ 840._RPP; c(2,1,5)=- 27._RPP/ 840._RPP; c(2,1,6)= 43._RPP/ 840._RPP; c(2,1,7)=- 125._RPP/ 840._RPP - c(2,0,4)=- 3._RPP/ 840._RPP; c(2,0,5)= 3._RPP/ 840._RPP; c(2,0,6)=- 5._RPP/ 840._RPP; c(2,0,7)= 15._RPP/ 840 _RPP + c(2,0,4)=- 3._RPP/ 840._RPP; c(2,0,5)= 3._RPP/ 840._RPP; c(2,0,6)=- 5._RPP/ 840._RPP; c(2,0,7)= 15._RPP/ 840._RPP case(9) ! 17th order ! 1 => left interface (i-1/2) ! cell 0 ; cell 1 ; cell 2 @@ -468,14 +467,16 @@ pure subroutine compute_with_stencil_of_rank_2(self, stencil) integer(I_P) :: s2 !< Counter. integer(I_P) :: f !< Counter. - self%values = 0._RPP + associate(val => self%values_rank_2) + val = 0._RPP do s1=0, self%S - 1 ! stencils loop do s2=0, self%S - 1 ! values loop do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s1) = self%values(f, s1) + self%coef(f, s2, s1) * stencil(f, -s2 + s1) + val(f, s1) = val(f, s1) + self%coef(f, s2, s1) * stencil(f, -s2 + s1) enddo enddo enddo + endassociate endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index 8bb2822..fadc194 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -88,7 +88,7 @@ pure subroutine interpolate_with_stencil_of_rank_1_debug(self, stencil, interpol real(RPP), intent(out) :: weights(0:) !< Weights of the stencils, [1:2, 0:S-1]. call self%interpolate_standard(stencil=stencil, interpolation=interpolation) - si = self%weights%smoothness_indicators() + call self%weights%smoothness_indicators_of_rank_1(si=si) weights = self%weights%values endsubroutine interpolate_with_stencil_of_rank_1_debug diff --git a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 index 8f2c0f5..e2b4c52 100644 --- a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 +++ b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 @@ -99,7 +99,8 @@ pure subroutine interpolate_with_stencil_of_rank_2_debug(self, stencil, interpol real(RPP), intent(out) :: weights(1:, 0:) !< Weights of the stencils, [1:2, 0:S-1]. call self%interpolate_standard(stencil=stencil, interpolation=interpolation) - si = self%weights%smoothness_indicators() + call self%weights%smoothness_indicators_of_rank_2(si=si) + !si = self%weights%smoothness_indicators() weights = self%weights%values endsubroutine interpolate_with_stencil_of_rank_2_debug diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 13c8c2f..40c4aee 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -28,17 +28,17 @@ module wenoof_weights_int_js implicit none private -public :: weight_int_js -public :: weight_int_js_constructor +public :: weights_int_js +public :: weights_int_js_constructor -type, extends(weights_object_constructor) :: weight_int_js_constructor +type, extends(weights_object_constructor) :: weights_int_js_constructor !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal weights object constructor. class(alpha_object_constructor), allocatable :: alpha_constructor !< Alpha coefficients (non linear weights) constructor. class(beta_object_constructor), allocatable :: beta_constructor !< Beta coefficients (smoothness indicators) constructor. class(kappa_object_constructor), allocatable :: kappa_constructor !< kappa coefficients (optimal, linear weights) constructor. -endtype weight_int_js_constructor +endtype weights_int_js_constructor -type, extends(weights_object):: weight_int_js +type, extends(weights_object):: weights_int_js !< Jiang-Shu and Gerolymos-Senechal-Vallet weights object. !< !< @note The provided WENO weights implements the weights defined in *Efficient Implementation of Weighted ENO @@ -58,13 +58,13 @@ module wenoof_weights_int_js procedure, pass(self) :: destroy !< Destroy weights. procedure, pass(self) :: smoothness_indicators_of_rank_1 !< Return smoothness indicators. procedure, pass(self) :: smoothness_indicators_of_rank_2 !< Return smoothness indicators. -endtype weight_int_js +endtype weights_int_js contains ! deferred public methods subroutine create(self, constructor) !< Create reconstructor. - class(weight_int_js), intent(inout) :: self !< Weights. + class(weights_int_js), intent(inout) :: self !< Weights. class(base_object_constructor), intent(in) :: constructor !< Constructor. type(alpha_factory) :: a_factory !< Alpha factory. type(beta_factory) :: b_factory !< Beta factory. @@ -72,10 +72,10 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) + allocate(self%values(0:self%S - 1)) self%values = 0._RPP select type(constructor) - type is(weight_int_js_constructor) + type is(weights_int_js_constructor) associate(alpha_constructor=>constructor%alpha_constructor, & beta_constructor=>constructor%beta_constructor, & kappa_constructor=>constructor%kappa_constructor) @@ -109,20 +109,20 @@ subroutine create(self, constructor) pure subroutine compute_with_stencil_of_rank_1(self, stencil) !< Compute weights. - class(weight_int_js), intent(inout) :: self !< Weights. + class(weights_int_js), intent(inout) :: self !< Weights. real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. integer(I_P) :: s !< Counters. call self%beta%compute(stencil=stencil) call self%alpha%compute(beta=self%beta, kappa=self%kappa) do s=0, self%S - 1 ! stencils loop - self%values(s) = self%alpha%values(s) / self%alpha%values_sum + self%values(s) = self%alpha%values_rank_1(s) / self%alpha%values_sum_rank_1 enddo endsubroutine compute_with_stencil_of_rank_1 pure subroutine compute_with_stencil_of_rank_2(self, stencil) !< Compute weights. - class(weight_int_js), intent(inout) :: self !< Weights. + class(weights_int_js), intent(inout) :: self !< Weights. real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. ! Empty routine. @@ -130,7 +130,7 @@ pure subroutine compute_with_stencil_of_rank_2(self, stencil) pure function description(self) result(string) !< Return string-description of weights. - class(weight_int_js), intent(in) :: self !< Weights. + class(weights_int_js), intent(in) :: self !< Weights. character(len=:), allocatable :: string !< String-description. character(len=1), parameter :: nl=new_line('a') !< New line char. @@ -141,7 +141,7 @@ pure function description(self) result(string) elemental subroutine destroy(self) !< Destroy weights. - class(weight_int_js), intent(inout) :: self !< Weights. + class(weights_int_js), intent(inout) :: self !< Weights. call self%destroy_ if (allocated(self%values)) deallocate(self%values) @@ -150,23 +150,23 @@ elemental subroutine destroy(self) if (allocated(self%kappa)) deallocate(self%kappa) endsubroutine destroy - pure function smoothness_indicators_of_rank_1(self) result(si) + pure subroutine smoothness_indicators_of_rank_1(self, si) !< Return smoothness indicators.. - class(weight_int_js), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:) !< Smoothness indicators. + class(weights_int_js), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. if (allocated(self%beta)) then - if (allocated(self%beta%values)) then - si = self%beta%values + if (allocated(self%beta%values_rank_1)) then + si = self%beta%values_rank_1 endif endif - endfunction smoothness_indicators_of_rank_1 + endsubroutine smoothness_indicators_of_rank_1 - pure function smoothness_indicators_of_rank_2(self) result(si) + pure subroutine smoothness_indicators_of_rank_2(self) !< Return smoothness indicators.. - class(weight_int_js), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:) !< Smoothness indicators. + class(weights_int_js), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. ! Empty routine - endfunction smoothness_indicators_of_rank_2 + endsubroutine smoothness_indicators_of_rank_2 endmodule wenoof_weights_int_js diff --git a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 index 8e23612..fd5d6a2 100644 --- a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 @@ -64,7 +64,7 @@ module wenoof_weights_rec_js ! deferred public methods subroutine create(self, constructor) !< Create reconstructor. - class(weight_rec_js), intent(inout) :: self !< Weights. + class(weights_rec_js), intent(inout) :: self !< Weights. class(base_object_constructor), intent(in) :: constructor !< Constructor. type(alpha_factory) :: a_factory !< Alpha factory. type(beta_factory) :: b_factory !< Beta factory. @@ -75,7 +75,7 @@ subroutine create(self, constructor) allocate(self%values(1:2, 0:self%S - 1)) self%values = 0._RPP select type(constructor) - type is(weight_rec_js_constructor) + type is(weights_rec_js_constructor) associate(alpha_constructor=>constructor%alpha_constructor, & beta_constructor=>constructor%beta_constructor, & kappa_constructor=>constructor%kappa_constructor) @@ -109,32 +109,32 @@ subroutine create(self, constructor) pure subroutine compute_with_stencil_of_rank_1(self, stencil) !< Compute weights. - class(weight_rec_js), intent(inout) :: self !< Weights. - real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + class(weights_rec_js), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. ! Empty routine. endsubroutine compute_with_stencil_of_rank_1 pure subroutine compute_with_stencil_of_rank_2(self, stencil) !< Compute weights. - class(weight_rec_js), intent(inout) :: self !< Weights. - real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. - integer(I_P) :: f, s !< Counters. + class(weights_rec_js), intent(inout) :: self !< Weights. + real(RPP), intent(in) :: stencil(1:,1-self%S:) !< Stencil used for the interpolation, [1:2, 1-S:-1+S]. + integer(I_P) :: f, s !< Counters. call self%beta%compute(stencil=stencil) call self%alpha%compute(beta=self%beta, kappa=self%kappa) do s=0, self%S - 1 ! stencils loop do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s) = self%alpha%values(f, s) / self%alpha%values_sum(f) + self%values(f, s) = self%alpha%values_rank_2(f, s) / self%alpha%values_sum_rank_2(f) enddo enddo endsubroutine compute_with_stencil_of_rank_2 pure function description(self) result(string) !< Return string-description of weights. - class(weight_rec_js), intent(in) :: self !< Weights. - character(len=:), allocatable :: string !< String-description. - character(len=1), parameter :: nl=new_line('a') !< New line char. + class(weights_rec_js), intent(in) :: self !< Weights. + character(len=:), allocatable :: string !< String-description. + character(len=1), parameter :: nl=new_line('a') !< New line char. string = ' Jiang-Shu weights:'//nl string = string//' - S = '//trim(str(self%S))//nl @@ -143,7 +143,7 @@ pure function description(self) result(string) elemental subroutine destroy(self) !< Destroy weights. - class(weight_rec_js), intent(inout) :: self !< Weights. + class(weights_rec_js), intent(inout) :: self !< Weights. call self%destroy_ if (allocated(self%values)) deallocate(self%values) @@ -152,23 +152,23 @@ elemental subroutine destroy(self) if (allocated(self%kappa)) deallocate(self%kappa) endsubroutine destroy - pure function smoothness_indicators_of_rank_1(self) result(si) + pure subroutine smoothness_indicators_of_rank_1(self) !< Return smoothness indicators.. - class(weight_rec_js), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:) !< Smoothness indicators. + class(weights_rec_js), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. ! Empty routine - endfunction smoothness_indicators_of_rank_1 + endsubroutine smoothness_indicators_of_rank_1 - pure function smoothness_indicators_of_rank_2(self) result(si) + pure subroutine smoothness_indicators_of_rank_2(self) !< Return smoothness indicators.. - class(weight_rec_js), intent(in) :: self !< Weights. - real(RPP), allocatable :: si(:,:) !< Smoothness indicators. + class(weights_rec_js), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. if (allocated(self%beta)) then - if (allocated(self%beta%values)) then - si = self%beta%values + if (allocated(self%beta%values_rank_2)) then + si = self%beta%values_rank_2 endif endif - endfunction smoothness_indicators_of_rank_2 + endsubroutine smoothness_indicators_of_rank_2 endmodule wenoof_weights_rec_js From d3914a8725d2a14cc2f05eed8760a9468a9ca17e Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 15:46:01 +0100 Subject: [PATCH 29/90] fix wrong weights routines --- src/lib/concrete_objects/wenoof_interpolations_int_js.F90 | 3 ++- src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 | 6 +++--- src/lib/concrete_objects/wenoof_weights_int_js.F90 | 6 +++--- src/lib/concrete_objects/wenoof_weights_rec_js.F90 | 4 ++-- 4 files changed, 10 insertions(+), 9 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index e37d0a8..ba46afd 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -334,6 +334,7 @@ pure subroutine compute_with_stencil_of_rank_1(self, stencil) val(s1) = val(s1) + self%coef(s2, s1) * stencil(-s2 + s1) enddo enddo + endassociate endsubroutine compute_with_stencil_of_rank_1 pure subroutine compute_with_stencil_of_rank_2(self, stencil) @@ -360,7 +361,7 @@ elemental subroutine destroy(self) class(interpolations_int_js), intent(inout) :: self !< Interpolations. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) if (allocated(self%coef)) deallocate(self%coef) endsubroutine destroy endmodule wenoof_interpolations_int_js diff --git a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 index 0974ae7..105792d 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_rec_js.F90 @@ -36,8 +36,8 @@ module wenoof_interpolations_rec_js contains ! public deferred methods procedure, pass(self) :: create !< Create interpolations. - procedure, pass(self) :: compute_with_stencil_or_rank_1 !< Compute interpolations. - procedure, pass(self) :: compute_with_stencil_or_rank_2 !< Compute interpolations. + procedure, pass(self) :: compute_with_stencil_of_rank_1 !< Compute interpolations. + procedure, pass(self) :: compute_with_stencil_of_rank_2 !< Compute interpolations. procedure, pass(self) :: description !< Return interpolations string-description. procedure, pass(self) :: destroy !< Destroy interpolations. endtype interpolations_rec_js @@ -495,7 +495,7 @@ elemental subroutine destroy(self) class(interpolations_rec_js), intent(inout) :: self !< Interpolations. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) if (allocated(self%coef)) deallocate(self%coef) endsubroutine destroy endmodule wenoof_interpolations_rec_js diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 40c4aee..78b7616 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -162,10 +162,10 @@ pure subroutine smoothness_indicators_of_rank_1(self, si) endif endsubroutine smoothness_indicators_of_rank_1 - pure subroutine smoothness_indicators_of_rank_2(self) + pure subroutine smoothness_indicators_of_rank_2(self, si) !< Return smoothness indicators.. - class(weights_int_js), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. + class(weights_int_js), intent(in) :: self !< Weights. + real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. ! Empty routine endsubroutine smoothness_indicators_of_rank_2 diff --git a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 index fd5d6a2..7761c70 100644 --- a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 @@ -152,7 +152,7 @@ elemental subroutine destroy(self) if (allocated(self%kappa)) deallocate(self%kappa) endsubroutine destroy - pure subroutine smoothness_indicators_of_rank_1(self) + pure subroutine smoothness_indicators_of_rank_1(self, si) !< Return smoothness indicators.. class(weights_rec_js), intent(in) :: self !< Weights. real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. @@ -160,7 +160,7 @@ pure subroutine smoothness_indicators_of_rank_1(self) ! Empty routine endsubroutine smoothness_indicators_of_rank_1 - pure subroutine smoothness_indicators_of_rank_2(self) + pure subroutine smoothness_indicators_of_rank_2(self, si) !< Return smoothness indicators.. class(weights_rec_js), intent(in) :: self !< Weights. real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. From db8aaa42ba212ca47263b9f275c018079e4e1b91 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 19:08:36 +0100 Subject: [PATCH 30/90] Refactored version of interpolate and reconstruct Short description Why: Interpolation is carried on a face, reconstruction on two. *COMPILE* This change addresses the need by: * Side effects: * --- .../wenoof_interpolator_object.F90 | 1 - .../abstract_objects/wenoof_weights_object.F90 | 6 ++++-- .../concrete_objects/wenoof_interpolator_js.F90 | 16 +++++++++------- .../concrete_objects/wenoof_reconstructor_js.F90 | 10 ++++++---- .../concrete_objects/wenoof_weights_int_js.F90 | 13 ++++++------- .../concrete_objects/wenoof_weights_rec_js.F90 | 13 ++++++------- src/lib/factories/wenoof_weights_factory.f90 | 6 +++++- src/tests/cos_reconstruction.f90 | 8 ++++---- src/tests/polynoms_interpolation.f90 | 8 ++++---- src/tests/polynoms_reconstruction.f90 | 8 ++++---- src/tests/sin_interpolation.f90 | 8 ++++---- 11 files changed, 52 insertions(+), 45 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_interpolator_object.F90 b/src/lib/abstract_objects/wenoof_interpolator_object.F90 index 3623551..de2dae3 100644 --- a/src/lib/abstract_objects/wenoof_interpolator_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolator_object.F90 @@ -43,7 +43,6 @@ module wenoof_interpolator_object deferred :: interpolate_with_stencil_of_rank_1_standard procedure(interpolate_with_stencil_of_rank_2_standard_interface), pass(self), & deferred :: interpolate_with_stencil_of_rank_2_standard - ! public methods endtype interpolator_object abstract interface diff --git a/src/lib/abstract_objects/wenoof_weights_object.F90 b/src/lib/abstract_objects/wenoof_weights_object.F90 index fd4404c..9d4c8be 100644 --- a/src/lib/abstract_objects/wenoof_weights_object.F90 +++ b/src/lib/abstract_objects/wenoof_weights_object.F90 @@ -20,6 +20,8 @@ module wenoof_weights_object type, extends(base_object), abstract :: weights_object !< Weights of stencil interpolations object. + real(RPP), allocatable :: values_rank_1(:) !< Weights values of stencil interpolations [0:S-1]. + real(RPP), allocatable :: values_rank_2(:,:) !< Weights values of stencil interpolations [1:2,0:S-1]. contains ! public methods generic :: compute => compute_with_stencil_of_rank_1, compute_with_stencil_of_rank_2 @@ -51,14 +53,14 @@ pure subroutine smoothness_indicators_of_rank_1_interface(self, si) !< Return smoothness indicators. import :: weights_object, RPP class(weights_object), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. + real(RPP), intent(out) :: si(:) !< Smoothness indicators. endsubroutine smoothness_indicators_of_rank_1_interface pure subroutine smoothness_indicators_of_rank_2_interface(self, si) !< Return smoothness indicators. import :: weights_object, RPP class(weights_object), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. + real(RPP), intent(out) :: si(:,:) !< Smoothness indicators. endsubroutine smoothness_indicators_of_rank_2_interface endinterface diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index fadc194..f357ab0 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -37,8 +37,10 @@ module wenoof_interpolator_js procedure, pass(self) :: create !< Create interpolator. procedure, pass(self) :: description !< Return interpolator string-description. procedure, pass(self) :: destroy !< Destroy interpolator. - procedure, pass(self) :: interpolate_standard !< Interpolate values (without providing debug values). - procedure, pass(self) :: interpolate_debug !< Interpolate values (providing also debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_1_standard !< Interpolate values (without providing debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_2_standard !< Interpolate values (without providing debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_1_debug !< Interpolate values (providing also debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_2_debug !< Interpolate values (providing also debug values). endtype interpolator_js contains @@ -89,7 +91,7 @@ pure subroutine interpolate_with_stencil_of_rank_1_debug(self, stencil, interpol call self%interpolate_standard(stencil=stencil, interpolation=interpolation) call self%weights%smoothness_indicators_of_rank_1(si=si) - weights = self%weights%values + weights = self%weights%values_rank_1 endsubroutine interpolate_with_stencil_of_rank_1_debug pure subroutine interpolate_with_stencil_of_rank_2_debug(self, stencil, interpolation, si, weights) @@ -114,15 +116,15 @@ pure subroutine interpolate_with_stencil_of_rank_1_standard(self, stencil, inter call self%weights%compute(stencil=stencil) interpolation = 0._RPP do s=0, self%S - 1 ! stencils loop - interpolation = interpolation + self%weights%values(s) * self%interpolations%values(s) + interpolation = interpolation + self%weights%values_rank_1(s) * self%interpolations%values_rank_1(s) enddo endsubroutine interpolate_with_stencil_of_rank_1_standard pure subroutine interpolate_with_stencil_of_rank_2_standard(self, stencil, interpolation) !< Interpolate values (without providing debug values). - class(reconstructor_js), intent(inout) :: self !< Reconstructor. - real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. - real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. + class(interpolator_js), intent(inout) :: self !< Reconstructor. + real(RPP), intent(in) :: stencil(1:, 1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. + real(RPP), intent(out) :: interpolation(1:) !< Result of the interpolation, [1:2]. ! Empty subroutine. endsubroutine interpolate_with_stencil_of_rank_2_standard diff --git a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 index e2b4c52..423b953 100644 --- a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 +++ b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 @@ -37,8 +37,10 @@ module wenoof_reconstructor_js procedure, pass(self) :: create !< Create reconstructor. procedure, pass(self) :: description !< Return reconstructor string-description. procedure, pass(self) :: destroy !< Destroy reconstructor. - procedure, pass(self) :: interpolate_debug !< Interpolate values (providing also debug values). - procedure, pass(self) :: interpolate_standard !< Interpolate values (without providing debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_1_standard !< Interpolate values (without providing debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_2_standard !< Interpolate values (without providing debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_1_debug !< Interpolate values (providing also debug values). + procedure, pass(self) :: interpolate_with_stencil_of_rank_2_debug !< Interpolate values (providing also debug values). endtype reconstructor_js contains @@ -101,7 +103,7 @@ pure subroutine interpolate_with_stencil_of_rank_2_debug(self, stencil, interpol call self%interpolate_standard(stencil=stencil, interpolation=interpolation) call self%weights%smoothness_indicators_of_rank_2(si=si) !si = self%weights%smoothness_indicators() - weights = self%weights%values + weights = self%weights%values_rank_2 endsubroutine interpolate_with_stencil_of_rank_2_debug pure subroutine interpolate_with_stencil_of_rank_1_standard(self, stencil, interpolation) @@ -125,7 +127,7 @@ pure subroutine interpolate_with_stencil_of_rank_2_standard(self, stencil, inter interpolation = 0._RPP do s=0, self%S - 1 ! stencils loop do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - interpolation(f) = interpolation(f) + self%weights%values(f, s) * self%interpolations%values(f, s) + interpolation(f) = interpolation(f) + self%weights%values_rank_2(f, s) * self%interpolations%values_rank_2(f, s) enddo enddo endsubroutine interpolate_with_stencil_of_rank_2_standard diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 78b7616..991d2d5 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -45,7 +45,6 @@ module wenoof_weights_int_js !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 - real(RPP), allocatable :: values(:) !< Weights values of stencil interpolations [1:2,0:S-1]. class(alpha_object), allocatable :: alpha !< Alpha coefficients (non linear weights). class(beta_object), allocatable :: beta !< Beta coefficients (smoothness indicators). class(kappa_object), allocatable :: kappa !< kappa coefficients (optimal, linear weights). @@ -72,8 +71,8 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(0:self%S - 1)) - self%values = 0._RPP + allocate(self%values_rank_1(0:self%S - 1)) + self%values_rank_1 = 0._RPP select type(constructor) type is(weights_int_js_constructor) associate(alpha_constructor=>constructor%alpha_constructor, & @@ -116,7 +115,7 @@ pure subroutine compute_with_stencil_of_rank_1(self, stencil) call self%beta%compute(stencil=stencil) call self%alpha%compute(beta=self%beta, kappa=self%kappa) do s=0, self%S - 1 ! stencils loop - self%values(s) = self%alpha%values_rank_1(s) / self%alpha%values_sum_rank_1 + self%values_rank_1(s) = self%alpha%values_rank_1(s) / self%alpha%values_sum_rank_1 enddo endsubroutine compute_with_stencil_of_rank_1 @@ -144,7 +143,7 @@ elemental subroutine destroy(self) class(weights_int_js), intent(inout) :: self !< Weights. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_1)) deallocate(self%values_rank_1) if (allocated(self%alpha)) deallocate(self%alpha) if (allocated(self%beta)) deallocate(self%beta) if (allocated(self%kappa)) deallocate(self%kappa) @@ -153,7 +152,7 @@ elemental subroutine destroy(self) pure subroutine smoothness_indicators_of_rank_1(self, si) !< Return smoothness indicators.. class(weights_int_js), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. + real(RPP), intent(out) :: si(:) !< Smoothness indicators. if (allocated(self%beta)) then if (allocated(self%beta%values_rank_1)) then @@ -165,7 +164,7 @@ pure subroutine smoothness_indicators_of_rank_1(self, si) pure subroutine smoothness_indicators_of_rank_2(self, si) !< Return smoothness indicators.. class(weights_int_js), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. + real(RPP), intent(out) :: si(:,:) !< Smoothness indicators. ! Empty routine endsubroutine smoothness_indicators_of_rank_2 diff --git a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 index 7761c70..5f5056e 100644 --- a/src/lib/concrete_objects/wenoof_weights_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_rec_js.F90 @@ -45,7 +45,6 @@ module wenoof_weights_rec_js !< Schemes*, Guang-Shan Jiang, Chi-Wang Shu, JCP, 1996, vol. 126, pp. 202--228, doi:10.1006/jcph.1996.0130 and !< *Very-high-order weno schemes*, G. A. Gerolymos, D. Senechal, I. Vallet, JCP, 2009, vol. 228, pp. 8481-8524, !< doi:10.1016/j.jcp.2009.07.039 - real(RPP), allocatable :: values(:,:) !< Weights values of stencil interpolations [1:2,0:S-1]. class(alpha_object), allocatable :: alpha !< Alpha coefficients (non linear weights). class(beta_object), allocatable :: beta !< Beta coefficients (smoothness indicators). class(kappa_object), allocatable :: kappa !< kappa coefficients (optimal, linear weights). @@ -72,8 +71,8 @@ subroutine create(self, constructor) call self%destroy call self%create_(constructor=constructor) - allocate(self%values(1:2, 0:self%S - 1)) - self%values = 0._RPP + allocate(self%values_rank_2(1:2, 0:self%S - 1)) + self%values_rank_2 = 0._RPP select type(constructor) type is(weights_rec_js_constructor) associate(alpha_constructor=>constructor%alpha_constructor, & @@ -125,7 +124,7 @@ pure subroutine compute_with_stencil_of_rank_2(self, stencil) call self%alpha%compute(beta=self%beta, kappa=self%kappa) do s=0, self%S - 1 ! stencils loop do f=1, 2 ! 1 => left interface (i-1/2), 2 => right interface (i+1/2) - self%values(f, s) = self%alpha%values_rank_2(f, s) / self%alpha%values_sum_rank_2(f) + self%values_rank_2(f, s) = self%alpha%values_rank_2(f, s) / self%alpha%values_sum_rank_2(f) enddo enddo endsubroutine compute_with_stencil_of_rank_2 @@ -146,7 +145,7 @@ elemental subroutine destroy(self) class(weights_rec_js), intent(inout) :: self !< Weights. call self%destroy_ - if (allocated(self%values)) deallocate(self%values) + if (allocated(self%values_rank_2)) deallocate(self%values_rank_2) if (allocated(self%alpha)) deallocate(self%alpha) if (allocated(self%beta)) deallocate(self%beta) if (allocated(self%kappa)) deallocate(self%kappa) @@ -155,7 +154,7 @@ elemental subroutine destroy(self) pure subroutine smoothness_indicators_of_rank_1(self, si) !< Return smoothness indicators.. class(weights_rec_js), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:) !< Smoothness indicators. + real(RPP), intent(out) :: si(:) !< Smoothness indicators. ! Empty routine endsubroutine smoothness_indicators_of_rank_1 @@ -163,7 +162,7 @@ pure subroutine smoothness_indicators_of_rank_1(self, si) pure subroutine smoothness_indicators_of_rank_2(self, si) !< Return smoothness indicators.. class(weights_rec_js), intent(in) :: self !< Weights. - real(RPP), allocatable, intent(out) :: si(:,:) !< Smoothness indicators. + real(RPP), intent(out) :: si(:,:) !< Smoothness indicators. if (allocated(self%beta)) then if (allocated(self%beta%values_rank_2)) then diff --git a/src/lib/factories/wenoof_weights_factory.f90 b/src/lib/factories/wenoof_weights_factory.f90 index e60c751..c339060 100644 --- a/src/lib/factories/wenoof_weights_factory.f90 +++ b/src/lib/factories/wenoof_weights_factory.f90 @@ -69,7 +69,11 @@ subroutine create_constructor(interpolator_type, S, alpha_constructor, beta_cons endselect call constructor%create(S=S) select type(constructor) - type is(weights_js_constructor) + type is(weights_int_js_constructor) + allocate(constructor%alpha_constructor, source=alpha_constructor) + allocate(constructor%beta_constructor, source=beta_constructor) + allocate(constructor%kappa_constructor, source=kappa_constructor) + type is(weights_rec_js_constructor) allocate(constructor%alpha_constructor, source=alpha_constructor) allocate(constructor%beta_constructor, source=beta_constructor) allocate(constructor%kappa_constructor, source=kappa_constructor) diff --git a/src/tests/cos_reconstruction.f90 b/src/tests/cos_reconstruction.f90 index d4b141b..3debe84 100644 --- a/src/tests/cos_reconstruction.f90 +++ b/src/tests/cos_reconstruction.f90 @@ -168,10 +168,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate_debug(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) self%solution(pn, s)%reconstruction(i) = & (self%solution(pn, s)%interpolations(2,i) - self%solution(pn, s)%interpolations(1,i))/self%solution(pn, s)%Dx enddo diff --git a/src/tests/polynoms_interpolation.f90 b/src/tests/polynoms_interpolation.f90 index cf567a9..3c5425a 100644 --- a/src/tests/polynoms_interpolation.f90 +++ b/src/tests/polynoms_interpolation.f90 @@ -163,10 +163,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate_debug(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) diff --git a/src/tests/polynoms_reconstruction.f90 b/src/tests/polynoms_reconstruction.f90 index 73757dd..f272565 100644 --- a/src/tests/polynoms_reconstruction.f90 +++ b/src/tests/polynoms_reconstruction.f90 @@ -167,10 +167,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%reconstruction(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate_debug(stencil=stencil, & + interpolation=self%solution(pn, s)%reconstruction(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 index 9e1c519..876572e 100644 --- a/src/tests/sin_interpolation.f90 +++ b/src/tests/sin_interpolation.f90 @@ -163,10 +163,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate_debug(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) From eb85738aae3e04a9b913d9a0dace9f9961e44edb Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 19:21:02 +0100 Subject: [PATCH 31/90] fixed wrong interpolator type --- src/tests/cos_reconstruction.f90 | 6 +++--- src/tests/polynoms_reconstruction.f90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/tests/cos_reconstruction.f90 b/src/tests/cos_reconstruction.f90 index 3debe84..74052e7 100644 --- a/src/tests/cos_reconstruction.f90 +++ b/src/tests/cos_reconstruction.f90 @@ -158,9 +158,9 @@ subroutine perform(self) call self%compute_reference_solution do s=1, self%ui%S_number - call wenoof_create(interpolator_type=trim(adjustl(self%ui%interpolator_type)), & - S=self%ui%S(s), & - interpolator=interpolator, & + call wenoof_create(interpolator_type='reconstructor-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & eps=self%ui%eps) if (self%ui%verbose) print '(A)', interpolator%description() allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) diff --git a/src/tests/polynoms_reconstruction.f90 b/src/tests/polynoms_reconstruction.f90 index f272565..f311622 100644 --- a/src/tests/polynoms_reconstruction.f90 +++ b/src/tests/polynoms_reconstruction.f90 @@ -157,9 +157,9 @@ subroutine perform(self) call self%compute_reference_solution do s=1, self%ui%S_number - call wenoof_create(interpolator_type=trim(adjustl(self%ui%interpolator_type)), & - S=self%ui%S(s), & - interpolator=interpolator, & + call wenoof_create(interpolator_type='reconstructor-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & eps=self%ui%eps) if (self%ui%verbose) print '(A)', interpolator%description() allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) From a53edd4148dc87f6c784d66cea1b8badc9a1287f Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 27 Feb 2017 19:25:53 +0100 Subject: [PATCH 32/90] update submodules --- src/third_party/FOLLIA | 2 +- src/third_party/PENF | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/third_party/FOLLIA b/src/third_party/FOLLIA index e16f16d..086a953 160000 --- a/src/third_party/FOLLIA +++ b/src/third_party/FOLLIA @@ -1 +1 @@ -Subproject commit e16f16d7117085c85554a06e8252597976fd8378 +Subproject commit 086a953ad0f17d31631077556faa34cb1422ee42 diff --git a/src/third_party/PENF b/src/third_party/PENF index cfafeea..e4ddeb2 160000 --- a/src/third_party/PENF +++ b/src/third_party/PENF @@ -1 +1 @@ -Subproject commit cfafeeacc2dcef861f03fc9f7e287997df9aa139 +Subproject commit e4ddeb2c3f02047a371f909b4e0e69a2926550a2 From 80780279c8ef5b1604428c4d5c849a1fed4069ee Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 28 Feb 2017 08:19:20 +0100 Subject: [PATCH 33/90] fix formatting --- src/lib/concrete_objects/wenoof_interpolator_js.F90 | 6 +++--- src/lib/concrete_objects/wenoof_reconstructor_js.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index f357ab0..ec2da77 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -34,9 +34,9 @@ module wenoof_interpolator_js !< 7, 8, 9 stencils composed of 2, 3, 4, 5, 6, 7, 8, 9 values, respectively. contains ! public deferred methods - procedure, pass(self) :: create !< Create interpolator. - procedure, pass(self) :: description !< Return interpolator string-description. - procedure, pass(self) :: destroy !< Destroy interpolator. + procedure, pass(self) :: create !< Create interpolator. + procedure, pass(self) :: description !< Return interpolator string-description. + procedure, pass(self) :: destroy !< Destroy interpolator. procedure, pass(self) :: interpolate_with_stencil_of_rank_1_standard !< Interpolate values (without providing debug values). procedure, pass(self) :: interpolate_with_stencil_of_rank_2_standard !< Interpolate values (without providing debug values). procedure, pass(self) :: interpolate_with_stencil_of_rank_1_debug !< Interpolate values (providing also debug values). diff --git a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 index 423b953..94b95f1 100644 --- a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 +++ b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 @@ -34,9 +34,9 @@ module wenoof_reconstructor_js !< 7, 8, 9 stencils composed of 2, 3, 4, 5, 6, 7, 8, 9 values, respectively. contains ! public deferred methods - procedure, pass(self) :: create !< Create reconstructor. - procedure, pass(self) :: description !< Return reconstructor string-description. - procedure, pass(self) :: destroy !< Destroy reconstructor. + procedure, pass(self) :: create !< Create reconstructor. + procedure, pass(self) :: description !< Return reconstructor string-description. + procedure, pass(self) :: destroy !< Destroy reconstructor. procedure, pass(self) :: interpolate_with_stencil_of_rank_1_standard !< Interpolate values (without providing debug values). procedure, pass(self) :: interpolate_with_stencil_of_rank_2_standard !< Interpolate values (without providing debug values). procedure, pass(self) :: interpolate_with_stencil_of_rank_1_debug !< Interpolate values (providing also debug values). From 176554df9f89cdc7f8ec66eaed20958f3651c1ae Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 28 Feb 2017 10:14:24 +0100 Subject: [PATCH 34/90] update modules to last commit --- src/third_party/FOLLIA | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/third_party/FOLLIA b/src/third_party/FOLLIA index 086a953..dd488fe 160000 --- a/src/third_party/FOLLIA +++ b/src/third_party/FOLLIA @@ -1 +1 @@ -Subproject commit 086a953ad0f17d31631077556faa34cb1422ee42 +Subproject commit dd488fe7dea640644a9d608e51ee2893578c30b9 From 8c9907918b06d9546491ec6c96c36803c21172bb Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 28 Feb 2017 10:21:30 +0100 Subject: [PATCH 35/90] fix generic interpolate procedure --- src/lib/abstract_objects/wenoof_interpolator_object.F90 | 4 ++-- src/lib/concrete_objects/wenoof_interpolator_js.F90 | 2 +- src/lib/concrete_objects/wenoof_reconstructor_js.F90 | 2 +- src/tests/cos_reconstruction.f90 | 8 ++++---- src/tests/polynoms_interpolation.f90 | 8 ++++---- src/tests/polynoms_reconstruction.f90 | 8 ++++---- src/tests/sin_interpolation.f90 | 8 ++++---- 7 files changed, 20 insertions(+), 20 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_interpolator_object.F90 b/src/lib/abstract_objects/wenoof_interpolator_object.F90 index de2dae3..7d05c4e 100644 --- a/src/lib/abstract_objects/wenoof_interpolator_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolator_object.F90 @@ -32,8 +32,8 @@ module wenoof_interpolator_object class(weights_object), allocatable :: weights !< Weights of interpolations. contains ! public methods - generic :: interpolate_debug => interpolate_with_stencil_of_rank_1_debug, interpolate_with_stencil_of_rank_2_debug - generic :: interpolate_standard => interpolate_with_stencil_of_rank_1_standard, interpolate_with_stencil_of_rank_2_standard + generic :: interpolate => interpolate_with_stencil_of_rank_1_debug, interpolate_with_stencil_of_rank_2_debug, & + interpolate_with_stencil_of_rank_1_standard, interpolate_with_stencil_of_rank_2_standard ! public deferred methods procedure(interpolate_with_stencil_of_rank_1_debug_interface), pass(self), & deferred :: interpolate_with_stencil_of_rank_1_debug diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index ec2da77..91329c6 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -89,7 +89,7 @@ pure subroutine interpolate_with_stencil_of_rank_1_debug(self, stencil, interpol real(RPP), intent(out) :: si(0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. real(RPP), intent(out) :: weights(0:) !< Weights of the stencils, [1:2, 0:S-1]. - call self%interpolate_standard(stencil=stencil, interpolation=interpolation) + call self%interpolate(stencil=stencil, interpolation=interpolation) call self%weights%smoothness_indicators_of_rank_1(si=si) weights = self%weights%values_rank_1 endsubroutine interpolate_with_stencil_of_rank_1_debug diff --git a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 index 94b95f1..171cfdd 100644 --- a/src/lib/concrete_objects/wenoof_reconstructor_js.F90 +++ b/src/lib/concrete_objects/wenoof_reconstructor_js.F90 @@ -100,7 +100,7 @@ pure subroutine interpolate_with_stencil_of_rank_2_debug(self, stencil, interpol real(RPP), intent(out) :: si(1:, 0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. real(RPP), intent(out) :: weights(1:, 0:) !< Weights of the stencils, [1:2, 0:S-1]. - call self%interpolate_standard(stencil=stencil, interpolation=interpolation) + call self%interpolate(stencil=stencil, interpolation=interpolation) call self%weights%smoothness_indicators_of_rank_2(si=si) !si = self%weights%smoothness_indicators() weights = self%weights%values_rank_2 diff --git a/src/tests/cos_reconstruction.f90 b/src/tests/cos_reconstruction.f90 index 74052e7..6234e04 100644 --- a/src/tests/cos_reconstruction.f90 +++ b/src/tests/cos_reconstruction.f90 @@ -168,10 +168,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate_debug(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) self%solution(pn, s)%reconstruction(i) = & (self%solution(pn, s)%interpolations(2,i) - self%solution(pn, s)%interpolations(1,i))/self%solution(pn, s)%Dx enddo diff --git a/src/tests/polynoms_interpolation.f90 b/src/tests/polynoms_interpolation.f90 index 3c5425a..cf567a9 100644 --- a/src/tests/polynoms_interpolation.f90 +++ b/src/tests/polynoms_interpolation.f90 @@ -163,10 +163,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate_debug(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) diff --git a/src/tests/polynoms_reconstruction.f90 b/src/tests/polynoms_reconstruction.f90 index f311622..5920ff1 100644 --- a/src/tests/polynoms_reconstruction.f90 +++ b/src/tests/polynoms_reconstruction.f90 @@ -167,10 +167,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate_debug(stencil=stencil, & - interpolation=self%solution(pn, s)%reconstruction(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%reconstruction(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 index 876572e..9e1c519 100644 --- a/src/tests/sin_interpolation.f90 +++ b/src/tests/sin_interpolation.f90 @@ -163,10 +163,10 @@ subroutine perform(self) do i=1, self%ui%points_number(pn) stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate_debug(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) + call interpolator%interpolate(stencil=stencil, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) enddo enddo deallocate(stencil) From ec127ef0b2160b609a97575d05e80f5104e98f61 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 13:28:02 +0100 Subject: [PATCH 36/90] modified kappa object for interpolation --- .../abstract_objects/wenoof_kappa_object.F90 | 21 +- .../concrete_objects/wenoof_kappa_int_js.F90 | 261 ++++++++++-------- .../wenoof_weights_int_js.F90 | 4 +- src/lib/factories/wenoof_kappa_factory.f90 | 43 ++- src/lib/factories/wenoof_objects_factory.f90 | 112 +++++++- src/lib/wenoof.F90 | 32 ++- 6 files changed, 308 insertions(+), 165 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index 0772d15..d7b561c 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -23,17 +23,28 @@ module wenoof_kappa_object real(RPP), allocatable :: values_rank_1(:) !< Kappa coefficients values [0:S-1]. real(RPP), allocatable :: values_rank_2(:,:) !< Kappa coefficients values [1:2,0:S-1]. contains - ! public deferred methods - procedure(compute_interface), pass(self), deferred :: compute !< Compute kappa. + ! public methods + generic :: compute => compute_kappa_rec, compute_kappa_int + ! deferred public methods + procedure(compute_kappa_rec_interface), pass(self), deferred :: compute_kappa_rec!< Compute interp. + procedure(compute_kappa_int_interface), pass(self), deferred :: compute_kappa_int!< Compute interp. endtype kappa_object abstract interface !< Abstract interfaces of [[kappa_object]]. - pure subroutine compute_interface(self) + pure subroutine compute_kappa_rec_interface(self) !< Compute kappa. import :: kappa_object - class(kappa_object), intent(inout) :: self !< Kappa. - endsubroutine compute_interface + class(kappa_object), intent(inout) :: self !< Kappa. + endsubroutine compute_kappa_rec_interface + + pure subroutine compute_kappa_int_interface(self, stencil, x_target) + !< Compute kappa. + import :: kappa_object + class(kappa_object), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + endsubroutine compute_kappa_int_interface endinterface endmodule wenoof_kappa_object diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 8f066bb..6e5be60 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -21,6 +21,8 @@ module wenoof_kappa_int_js type, extends(kappa_object_constructor) :: kappa_int_js_constructor !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal kappa object constructor. + real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP) :: x_target !< Coordinate of the interpolation point. endtype kappa_int_js_constructor type, extends(kappa_object):: kappa_int_js @@ -32,7 +34,8 @@ module wenoof_kappa_int_js contains ! public deferred methods procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute => compute_kappa_int !< Compute kappa. + procedure, pass(self) :: compute_kappa_rec !< Compute kappa. + procedure, pass(self) :: compute_kappa_int !< Compute kappa. procedure, pass(self) :: description !< Return kappa string-description. procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_int_js @@ -50,128 +53,150 @@ subroutine create(self, constructor) call self%create_(constructor=constructor) allocate(self%values_rank_1(0:self%S - 1)) self%values_rank_1 = 0._RPP - call self%compute + call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) endsubroutine create - pure subroutine compute_kappa_int(self) + pure subroutine compute_kappa_rec(self) !< Compute kappa. class(kappa_int_js), intent(inout) :: self !< Kappa. - associate(val => self%values_rank_1) - select case(self%S) - case(2) ! 3rd order - ! 1 => left interface (i-1/2) - val(0) = 3._RPP/4._RPP ! stencil 0 - val(1) = 1._RPP/4._RPP ! stencil 1 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/4._RPP ! stencil 0 - val(1) = 3._RPP/4._RPP ! stencil 1 - case(3) ! 5th order - ! 1 => left interface (i-1/2) - val(0) = 5._RPP/16._RPP ! stencil 0 - val(1) = 5._RPP/8._RPP ! stencil 1 - val(2) = 1._RPP/16._RPP ! stencil 2 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/16._RPP ! stencil 0 - val(1) = 5._RPP/8._RPP ! stencil 1 - val(2) = 5._RPP/16._RPP ! stencil 2 - case(4) ! 7th order - ! 1 => left interface (i-1/2) - val(0) = 7._RPP/64._RPP ! stencil 0 - val(1) = 35._RPP/64._RPP ! stencil 1 - val(2) = 21._RPP/64._RPP ! stencil 2 - val(3) = 1._RPP/64._RPP ! stencil 3 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/64._RPP ! stencil 0 - val(1) = 21._RPP/64._RPP ! stencil 1 - val(2) = 35._RPP/64._RPP ! stencil 2 - val(3) = 7._RPP/64._RPP ! stencil 3 - case(5) ! 9th order - ! 1 => left interface (i-1/2) - val(0) = 9._RPP/256._RPP ! stencil 0 - val(1) = 21._RPP/64._RPP ! stencil 1 - val(2) = 63._RPP/128._RPP ! stencil 2 - val(3) = 9._RPP/64._RPP ! stencil 3 - val(4) = 1._RPP/256._RPP ! stencil 4 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/256._RPP ! stencil 0 - val(1) = 9._RPP/64._RPP ! stencil 1 - val(2) = 63._RPP/128._RPP ! stencil 2 - val(3) = 21._RPP/64._RPP ! stencil 3 - val(4) = 9._RPP/256._RPP ! stencil 4 - case(6) ! 11th order - ! 1 => left interface (i-1/2) - val(0) = 11._RPP/1024._RPP ! stencil 0 - val(1) = 165._RPP/1024._RPP ! stencil 1 - val(2) = 231._RPP/512._RPP ! stencil 2 - val(3) = 165._RPP/512._RPP ! stencil 3 - val(4) = 55._RPP/1024._RPP ! stencil 4 - val(5) = 1._RPP/1024._RPP ! stencil 5 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/1024._RPP ! stencil 0 - val(1) = 55._RPP/1024._RPP ! stencil 1 - val(2) = 165._RPP/512._RPP ! stencil 2 - val(3) = 231._RPP/512._RPP ! stencil 3 - val(4) = 165._RPP/1024._RPP ! stencil 4 - val(5) = 11._RPP/1024._RPP ! stencil 5 - case(7) ! 13th order - ! 1 => left interface (i-1/2) - val(0) = 13._RPP/4096._RPP ! stencil 0 - val(1) = 143._RPP/2048._RPP ! stencil 1 - val(2) = 1287._RPP/4096._RPP ! stencil 2 - val(3) = 429._RPP/1024._RPP ! stencil 3 - val(4) = 179._RPP/1024._RPP ! stencil 4 - val(5) = 39._RPP/2048._RPP ! stencil 5 - val(6) = 1._RPP/4096._RPP ! stencil 6 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/4096._RPP ! stencil 0 - val(1) = 39._RPP/2048._RPP ! stencil 1 - val(2) = 179._RPP/1024._RPP ! stencil 2 - val(3) = 429._RPP/1024._RPP ! stencil 3 - val(4) = 1287._RPP/4096._RPP ! stencil 4 - val(5) = 143._RPP/2048._RPP ! stencil 5 - val(6) = 13._RPP/4096._RPP ! stencil 6 - case(8) ! 15th order - ! 1 => left interface (i-1/2) - val(0) = 15._RPP/16384._RPP ! stencil 0 - val(1) = 455._RPP/16384._RPP ! stencil 1 - val(2) = 3003._RPP/16384._RPP ! stencil 2 - val(3) = 6435._RPP/16384._RPP ! stencil 3 - val(4) = 5005._RPP/16384._RPP ! stencil 4 - val(5) = 1365._RPP/16384._RPP ! stencil 5 - val(6) = 105._RPP/16384._RPP ! stencil 6 - val(7) = 1._RPP/16384._RPP ! stencil 7 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/16384._RPP ! stencil 0 - val(1) = 105._RPP/16384._RPP ! stencil 1 - val(2) = 1365._RPP/16384._RPP ! stencil 2 - val(3) = 5005._RPP/16384._RPP ! stencil 3 - val(4) = 6435._RPP/16384._RPP ! stencil 4 - val(5) = 3003._RPP/16384._RPP ! stencil 5 - val(6) = 455._RPP/16384._RPP ! stencil 6 - val(7) = 15._RPP/16384._RPP ! stencil 7 - case(9) ! 17th order - ! 1 => left interface (i-1/2) - val(0) = 17._RPP/65536._RPP ! stencil 0 - val(1) = 85._RPP/8192._RPP ! stencil 1 - val(2) = 1547._RPP/16384._RPP ! stencil 2 - val(3) = 2431._RPP/8192._RPP ! stencil 3 - val(4) = 12155._RPP/32768._RPP ! stencil 4 - val(5) = 1547._RPP/8192._RPP ! stencil 5 - val(6) = 595._RPP/16384._RPP ! stencil 6 - val(7) = 17._RPP/8192._RPP ! stencil 7 - val(8) = 1._RPP/65536._RPP ! stencil 8 - ! 2 => right interface (i+1/2) - val(0) = 1._RPP/65536._RPP ! stencil 0 - val(1) = 17._RPP/8192._RPP ! stencil 1 - val(2) = 595._RPP/16384._RPP ! stencil 2 - val(3) = 1547._RPP/8192._RPP ! stencil 3 - val(4) = 12155._RPP/32768._RPP ! stencil 4 - val(5) = 2431._RPP/8192._RPP ! stencil 5 - val(6) = 1547._RPP/16384._RPP ! stencil 6 - val(7) = 85._RPP/8192._RPP ! stencil 7 - val(8) = 17._RPP/65536._RPP ! stencil 8 - endselect + ! Empty subroutine + endsubroutine compute_kappa_rec + + pure subroutine compute_kappa_int(self, stencil, x_target) + !< Compute kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + real(RPP) :: prod !< Temporary variable. + integer(I_P) :: i, j ,k !< Counters. + + associate(S => self%S,val => self%values_rank_1) + if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then + ! left interface (i-1/2) + select case(S) + case(2) ! 3rd order + val(0) = 3._RPP/4._RPP ! stencil 0 + val(1) = 1._RPP/4._RPP ! stencil 1 + case(3) ! 5th order + val(0) = 5._RPP/16._RPP ! stencil 0 + val(1) = 5._RPP/8._RPP ! stencil 1 + val(2) = 1._RPP/16._RPP ! stencil 2 + case(4) ! 7th order + val(0) = 7._RPP/64._RPP ! stencil 0 + val(1) = 35._RPP/64._RPP ! stencil 1 + val(2) = 21._RPP/64._RPP ! stencil 2 + val(3) = 1._RPP/64._RPP ! stencil 3 + case(5) ! 9th order + val(0) = 9._RPP/256._RPP ! stencil 0 + val(1) = 21._RPP/64._RPP ! stencil 1 + val(2) = 63._RPP/128._RPP ! stencil 2 + val(3) = 9._RPP/64._RPP ! stencil 3 + val(4) = 1._RPP/256._RPP ! stencil 4 + case(6) ! 11th order + val(0) = 11._RPP/1024._RPP ! stencil 0 + val(1) = 165._RPP/1024._RPP ! stencil 1 + val(2) = 231._RPP/512._RPP ! stencil 2 + val(3) = 165._RPP/512._RPP ! stencil 3 + val(4) = 55._RPP/1024._RPP ! stencil 4 + val(5) = 1._RPP/1024._RPP ! stencil 5 + case(7) ! 13th order + val(0) = 13._RPP/4096._RPP ! stencil 0 + val(1) = 143._RPP/2048._RPP ! stencil 1 + val(2) = 1287._RPP/4096._RPP ! stencil 2 + val(3) = 429._RPP/1024._RPP ! stencil 3 + val(4) = 179._RPP/1024._RPP ! stencil 4 + val(5) = 39._RPP/2048._RPP ! stencil 5 + val(6) = 1._RPP/4096._RPP ! stencil 6 + case(8) ! 15th order + val(0) = 15._RPP/16384._RPP ! stencil 0 + val(1) = 455._RPP/16384._RPP ! stencil 1 + val(2) = 3003._RPP/16384._RPP ! stencil 2 + val(3) = 6435._RPP/16384._RPP ! stencil 3 + val(4) = 5005._RPP/16384._RPP ! stencil 4 + val(5) = 1365._RPP/16384._RPP ! stencil 5 + val(6) = 105._RPP/16384._RPP ! stencil 6 + val(7) = 1._RPP/16384._RPP ! stencil 7 + case(9) ! 17th order + val(0) = 17._RPP/65536._RPP ! stencil 0 + val(1) = 85._RPP/8192._RPP ! stencil 1 + val(2) = 1547._RPP/16384._RPP ! stencil 2 + val(3) = 2431._RPP/8192._RPP ! stencil 3 + val(4) = 12155._RPP/32768._RPP ! stencil 4 + val(5) = 1547._RPP/8192._RPP ! stencil 5 + val(6) = 595._RPP/16384._RPP ! stencil 6 + val(7) = 17._RPP/8192._RPP ! stencil 7 + val(8) = 1._RPP/65536._RPP ! stencil 8 + endselect + elseif((x_target-(stencil(0)+stencil(1))/2._RPP)<10._RPP**(-10)) then + ! right interface (i+1/2) + select case(S) + case(2) ! 3rd order + val(0) = 1._RPP/4._RPP ! stencil 0 + val(1) = 3._RPP/4._RPP ! stencil 1 + case(3) ! 5th order + val(0) = 1._RPP/16._RPP ! stencil 0 + val(1) = 5._RPP/8._RPP ! stencil 1 + val(2) = 5._RPP/16._RPP ! stencil 2 + case(4) ! 7th order + val(0) = 1._RPP/64._RPP ! stencil 0 + val(1) = 21._RPP/64._RPP ! stencil 1 + val(2) = 35._RPP/64._RPP ! stencil 2 + val(3) = 7._RPP/64._RPP ! stencil 3 + case(5) ! 9th order + val(0) = 1._RPP/256._RPP ! stencil 0 + val(1) = 9._RPP/64._RPP ! stencil 1 + val(2) = 63._RPP/128._RPP ! stencil 2 + val(3) = 21._RPP/64._RPP ! stencil 3 + val(4) = 9._RPP/256._RPP ! stencil 4 + case(6) ! 11th order + val(0) = 1._RPP/1024._RPP ! stencil 0 + val(1) = 55._RPP/1024._RPP ! stencil 1 + val(2) = 165._RPP/512._RPP ! stencil 2 + val(3) = 231._RPP/512._RPP ! stencil 3 + val(4) = 165._RPP/1024._RPP ! stencil 4 + val(5) = 11._RPP/1024._RPP ! stencil 5 + case(7) ! 13th order + val(0) = 1._RPP/4096._RPP ! stencil 0 + val(1) = 39._RPP/2048._RPP ! stencil 1 + val(2) = 179._RPP/1024._RPP ! stencil 2 + val(3) = 429._RPP/1024._RPP ! stencil 3 + val(4) = 1287._RPP/4096._RPP ! stencil 4 + val(5) = 143._RPP/2048._RPP ! stencil 5 + val(6) = 13._RPP/4096._RPP ! stencil 6 + case(8) ! 15th order + val(0) = 1._RPP/16384._RPP ! stencil 0 + val(1) = 105._RPP/16384._RPP ! stencil 1 + val(2) = 1365._RPP/16384._RPP ! stencil 2 + val(3) = 5005._RPP/16384._RPP ! stencil 3 + val(4) = 6435._RPP/16384._RPP ! stencil 4 + val(5) = 3003._RPP/16384._RPP ! stencil 5 + val(6) = 455._RPP/16384._RPP ! stencil 6 + val(7) = 15._RPP/16384._RPP ! stencil 7 + case(9) ! 17th order + val(0) = 1._RPP/65536._RPP ! stencil 0 + val(1) = 17._RPP/8192._RPP ! stencil 1 + val(2) = 595._RPP/16384._RPP ! stencil 2 + val(3) = 1547._RPP/8192._RPP ! stencil 3 + val(4) = 12155._RPP/32768._RPP ! stencil 4 + val(5) = 2431._RPP/8192._RPP ! stencil 5 + val(6) = 1547._RPP/16384._RPP ! stencil 6 + val(7) = 85._RPP/8192._RPP ! stencil 7 + val(8) = 17._RPP/65536._RPP ! stencil 8 + endselect + else + ! internal point + do k=0,S-1 !stencils loop + do j=0,S-1 !values loop + prod = 1._RPP + do i=0,S-1 + if (-S+k+j==-S+k+i) cycle + prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j) - stencil(-S+k+i+1))) + enddo + val(j,k) = prod + enddo + enddo + endif endassociate endsubroutine compute_kappa_int diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 991d2d5..3750d36 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -109,8 +109,8 @@ subroutine create(self, constructor) pure subroutine compute_with_stencil_of_rank_1(self, stencil) !< Compute weights. class(weights_int_js), intent(inout) :: self !< Weights. - real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. - integer(I_P) :: s !< Counters. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for the interpolation, [1-S:-1+S]. + integer(I_P) :: s !< Counters. call self%beta%compute(stencil=stencil) call self%alpha%compute(beta=self%beta, kappa=self%kappa) diff --git a/src/lib/factories/wenoof_kappa_factory.f90 b/src/lib/factories/wenoof_kappa_factory.f90 index 5f68528..ade38ec 100644 --- a/src/lib/factories/wenoof_kappa_factory.f90 +++ b/src/lib/factories/wenoof_kappa_factory.f90 @@ -15,8 +15,10 @@ module wenoof_kappa_factory !< Factory, create an instance of concrete extension of [[kappa_object]] given its constructor. contains ! public methods - procedure, nopass :: create !< Create a concrete instance of [[kappa_object]]. - procedure, nopass :: create_constructor !< Create a concrete instance of [[kappa_object_constructor]]. + procedure, nopass :: create !< Create a concrete instance of [[kappa_object]]. + procedure, nopass, generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance + create_constructor_int !< of [[kappa_object_constructor]]. + endtype kappa_factory contains @@ -36,30 +38,27 @@ subroutine create(constructor, object) call object%create(constructor=constructor) endsubroutine create - subroutine create_constructor(interpolator_type, S, constructor) + subroutine create_constructor_rec(interpolator_type, S, constructor) !< Create an instance of concrete extension of [[kappa_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - select case(trim(adjustl(interpolator_type))) - case('interpolator-JS') - allocate(kappa_int_js_constructor :: constructor) - case('interpolator-M-JS') - allocate(kappa_int_js_constructor :: constructor) - case('interpolator-M-Z') - allocate(kappa_int_js_constructor :: constructor) - case('interpolator-Z') - allocate(kappa_int_js_constructor :: constructor) - case('reconstructor-JS') - allocate(kappa_rec_js_constructor :: constructor) - case('reconstructor-M-JS') - allocate(kappa_rec_js_constructor :: constructor) - case('reconstructor-M-Z') - allocate(kappa_rec_js_constructor :: constructor) - case('reconstructor-Z') - allocate(kappa_rec_js_constructor :: constructor) - endselect + allocate(kappa_rec_js_constructor :: constructor) + call constructor%create(S=S) + endsubroutine create_constructor_rec + + subroutine create_constructor_int(interpolator_type, S, stencil, x_target, constructor) + !< Create an instance of concrete extension of [[kappa_object_constructor]]. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. + class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + + allocate(kappa_int_js_constructor :: constructor) + allocate(stencil :: constructor%stencil) + constructor%x_target = x_target call constructor%create(S=S) - endsubroutine create_constructor + endsubroutine create_constructor_int endmodule wenoof_kappa_factory diff --git a/src/lib/factories/wenoof_objects_factory.f90 b/src/lib/factories/wenoof_objects_factory.f90 index e20b8a8..6b4516f 100644 --- a/src/lib/factories/wenoof_objects_factory.f90 +++ b/src/lib/factories/wenoof_objects_factory.f90 @@ -32,16 +32,19 @@ module wenoof_objects_factory create_beta_object, & create_kappa_object, & create_interpolations_object, & + create_reconstructor, & create_interpolator, & create_interpolator_object, & create_weights_object !< Create a concrete instance of [[alpha_object]], [[beta_object]], !< [[kappa_object]], [[interpolations_object]], [[interpolator_object]] or !< [[weights_object]]. - generic :: create_constructor => create_alpha_object_constructor, & - create_beta_object_constructor, & - create_kappa_object_constructor, & - create_interpolations_object_constructor, & - create_interpolator_object_constructor, & + generic :: create_constructor => create_alpha_object_constructor, & + create_beta_object_constructor, & + create_kappa_rec_object_constructor, & + create_kappa_int_object_constructor, & + create_interpolations_rec_object_constructor, & + create_interpolations_int_object_constructor, & + create_interpolator_object_constructor, & create_weights_object_constructor !< Create a concrete instance of !< [[alpha_object_constructor]], [[beta_object_constructor]], !< [[kappa_object_constructor]], @@ -101,7 +104,7 @@ subroutine create_interpolations_object(constructor, object) call factory%create(constructor=constructor, object=object) endsubroutine create_interpolations_object - subroutine create_interpolator(self, interpolator_type, S, interpolator, eps) + subroutine create_reconstructor(self, interpolator_type, S, interpolator, eps) !< Create an instance of concrete extension of [[interpolator_object]] given user options. class(objects_factory), intent(in) :: self !< The factory. character(*), intent(in) :: interpolator_type !< Type of the interpolator. @@ -143,6 +146,59 @@ subroutine create_interpolator(self, interpolator_type, S, interpolator, eps) weights_constructor=weights_constructor, & constructor=interpolator_constructor) + call self%create_interpolator_object(constructor=interpolator_constructor, object=interpolator) + endsubroutine create_reconstructor + + subroutine create_interpolator(self, interpolator_type, S, interpolator, stencil, xtarget, eps) + !< Create an instance of concrete extension of [[interpolator_object]] given user options. + class(objects_factory), intent(in) :: self !< The factory. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + class(interpolator_object), allocatable, intent(out) :: interpolator !< Interpolator. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. + real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero/div. + class(alpha_object_constructor), allocatable :: alpha_constructor !< Alpha constructor. + class(beta_object_constructor), allocatable :: beta_constructor !< Beta constructor. + class(interpolations_object_constructor), allocatable :: interpolations_constructor !< Interpolations constructor. + class(kappa_object_constructor), allocatable :: kappa_constructor !< Kappa constructor. + class(weights_object_constructor), allocatable :: weights_constructor !< Weights constructor. + class(interpolator_object_constructor), allocatable :: interpolator_constructor !< Interpolator constructor. + + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + constructor=alpha_constructor, & + eps=eps) + + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + constructor=beta_constructor) + + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + stencil=stencil, & + x_target=x_target, & + constructor=kappa_constructor) + + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + alpha_constructor=alpha_constructor, & + beta_constructor=beta_constructor, & + kappa_constructor=kappa_constructor, & + constructor=weights_constructor) + + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + stencil=stencil, & + x_target=x_target, & + constructor=interpolations_constructor) + + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + interpolations_constructor=interpolations_constructor, & + weights_constructor=weights_constructor, & + constructor=interpolator_constructor) + call self%create_interpolator_object(constructor=interpolator_constructor, object=interpolator) endsubroutine create_interpolator @@ -190,27 +246,61 @@ subroutine create_beta_object_constructor(interpolator_type, S, constructor) constructor=constructor) endsubroutine create_beta_object_constructor - subroutine create_kappa_object_constructor(interpolator_type, S, constructor) + subroutine create_kappa_int_object_constructor(interpolator_type, S, stencil, x_target, constructor) !< Create an instance of concrete extension of [[kappa_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. type(kappa_factory) :: factory !< The factory. - call factory%create_constructor(interpolator_type=interpolator_type, S=S, constructor=constructor) - endsubroutine create_kappa_object_constructor + call factory%create_constructor(interpolator_type=interpolator_type, & + S=S, & + stencil=stencil, & + x_target=x_target, & + constructor=constructor) + endsubroutine create_kappa_int_object_constructor + + subroutine create_kappa_rec_object_constructor(interpolator_type, S, constructor) + !< Create an instance of concrete extension of [[kappa_object_constructor]]. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + type(kappa_factory) :: factory !< The factory. + + call factory%create_constructor(interpolator_type=interpolator_type, & + S=S, & + constructor=constructor) + endsubroutine create_kappa_rec_object_constructor + + subroutine create_interpolations_rec_object_constructor(interpolator_type, S, constructor) + !< Create an instance of concrete extension of [[interpolations_object_constructor]]. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + type(interpolations_factory) :: factory !< The factory. + + call factory%create_constructor(interpolator_type=interpolator_type, & + S=S, & + constructor=constructor) + endsubroutine create_interpolations_rec_object_constructor - subroutine create_interpolations_object_constructor(interpolator_type, S, constructor) + subroutine create_interpolations_int_object_constructor(interpolator_type, S, stencil, x_target, constructor) !< Create an instance of concrete extension of [[interpolations_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. type(interpolations_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & S=S, & + stencil=stencil, & + x_target=x_target, & constructor=constructor) - endsubroutine create_interpolations_object_constructor + endsubroutine create_interpolations_int_object_constructor subroutine create_interpolator_object_constructor(interpolator_type, S, interpolations_constructor, weights_constructor, & constructor) diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index ba8c506..c81b057 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -12,11 +12,11 @@ module wenoof implicit none private -public :: interpolator_object -public :: wenoof_create +public :: interpolator_object +generic, public :: wenoof_create => wenoof_create_reconstructor, wenoof_create_interpolator contains - subroutine wenoof_create(interpolator_type, S, interpolator, eps) + subroutine wenoof_create_reconstructor(interpolator_type, S, interpolator, eps) !< WenOOF creator, create a concrete WENO interpolator object. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencil dimension. @@ -24,9 +24,27 @@ subroutine wenoof_create(interpolator_type, S, interpolator, eps) real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero-div. type(objects_factory) :: factory !< The factory. - call factory%create(interpolator_type=interpolator_type, & - S=S, & - interpolator=interpolator, & + call factory%create(interpolator_type='reconstructor-'//interpolator_type, & + S=S, & + interpolator=interpolator, & eps=eps) - endsubroutine wenoof_create + endsubroutine wenoof_create_reconstructor + + subroutine wenoof_create_interpolator(interpolator_type, S, interpolator, stencil, x_target, eps) + !< WenOOF creator, create a concrete WENO interpolator object. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencil dimension. + class(interpolator_object), allocatable, intent(out) :: interpolator !< The concrete WENO interpolator. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for interpolation, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero-div. + type(objects_factory) :: factory !< The factory. + + call factory%create(interpolator_type='interpolator-'//interpolator_type, & + S=S, & + interpolator=interpolator, & + stencil=stencil, & + x_target=x_target, & + eps=eps) + endsubroutine wenoof_create_interpolator endmodule wenoof From 6ddde8a827033ba74e776553a6c61702b9f2dbb5 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 16:57:05 +0100 Subject: [PATCH 37/90] fix kappa evaluation for internal point --- .../concrete_objects/wenoof_kappa_int_js.F90 | 30 ++++++++++++------- 1 file changed, 19 insertions(+), 11 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 6e5be60..aa90e6d 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -13,6 +13,7 @@ module wenoof_kappa_int_js #endif use wenoof_base_object use wenoof_kappa_object +use wenoof_interpolations_int_js implicit none private @@ -65,13 +66,13 @@ pure subroutine compute_kappa_rec(self) pure subroutine compute_kappa_int(self, stencil, x_target) !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. + class(kappa_int_js), intent(inout) :: self !< Kappa. real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. real(RPP) :: prod !< Temporary variable. - integer(I_P) :: i, j ,k !< Counters. + integer(I_P) :: i, j !< Counters. - associate(S => self%S,val => self%values_rank_1) + associate(S => self%S, val => self%values_rank_1, c => interpolations_int_js%coef) if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then ! left interface (i-1/2) select case(S) @@ -186,16 +187,23 @@ pure subroutine compute_kappa_int(self, stencil, x_target) endselect else ! internal point - do k=0,S-1 !stencils loop - do j=0,S-1 !values loop - prod = 1._RPP - do i=0,S-1 - if (-S+k+j==-S+k+i) cycle - prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j) - stencil(-S+k+i+1))) - enddo - val(j,k) = prod + allocate(coef(0:2*S-2)) + do j=0,2*S-2 !values loop + prod = 1._RPP + do i=0,2*S-2 + if (i==j) cycle + prod = prod * ((x_target - stencil(-S+i+1)) / (stencil(-S+j+1) - stencil(-S+i+1))) + enddo + coef(j) = prod + enddo + do j = 0,S-1 + coeff = 0._RPP + do i = 0, j-1 + coeff = coeff + val(i) * c(j,i) enddo + val(j) = (coef(j) - coeff) / c(j,i) enddo + deallocate(coef) endif endassociate endsubroutine compute_kappa_int From 72b614354d8a2e52a4e5c9d4072f254ac598f61a Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 16:59:05 +0100 Subject: [PATCH 38/90] add .gdb_history file --- .gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.gitignore b/.gitignore index db8e9eb..9c56d00 100644 --- a/.gitignore +++ b/.gitignore @@ -28,6 +28,9 @@ *.dat *.png +# gdb history +.gdb_history + # special directories doc/html/ exe/ From bef31ac0ef13394bb2711a81245b52052ee32faf Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 17:15:46 +0100 Subject: [PATCH 39/90] remove .gdb_history file --- .gdb_history | 96 ---------------------------------------------------- 1 file changed, 96 deletions(-) delete mode 100644 .gdb_history diff --git a/.gdb_history b/.gdb_history deleted file mode 100644 index ce964da..0000000 --- a/.gdb_history +++ /dev/null @@ -1,96 +0,0 @@ -w -where -q -l -l -w -where -l -l -l1 -l 1 -l -l -l -l -l -l -l -l -l -l -l -l -w -where -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -l -b 332 -r -s -l -l -n -p self%ui%interpolator_type -n -s -l -l -n -n -n -n -n -n -n -n -p eps -n -p S -n -p eps -n -n -p S -n -whatis stencil -n -p pn -n -n -n -n -n -n -n -n -n -n -n -n -n -n -n -w -l -n -q From db1436f15457c63b2639dec5f57d57a1f4d07b78 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 17:25:01 +0100 Subject: [PATCH 40/90] add interpolation evaluation for internal point --- .../wenoof_interpolations_int_js.F90 | 541 +++++++++--------- .../wenoof_interpolations_factory.f90 | 42 +- src/lib/factories/wenoof_objects_factory.f90 | 12 +- 3 files changed, 306 insertions(+), 289 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index ba46afd..8040111 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -21,6 +21,8 @@ module wenoof_interpolations_int_js type, extends(interpolations_object_constructor) :: interpolations_int_js_constructor !< Jiang-Shu (Lagrange) interpolations object for function interpolation constructor. + real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP) :: x_target !< Coordinate of the interpolation point. endtype interpolations_int_js_constructor type, extends(interpolations_object) :: interpolations_int_js @@ -52,271 +54,282 @@ subroutine create(self, constructor) allocate(self%values_rank_1(0:self%S - 1)) self%values_rank_1 = 0._RPP allocate(self%coef(0:self%S - 1, 0:self%S - 1)) - associate(c => self%coef) - select case(self%S) - case(2) ! 3rd order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 - c(0,0)= 0.5_RPP; c(1,0)= 0.5_RPP ! stencil 0 - c(0,1)= 1.5_RPP; c(1,1)= -0.5_RPP ! stencil 1 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 - c(0,0)= -0.5_RPP; c(1,0)= 1.5_RPP ! stencil 0 - c(0,1)= 0.5_RPP; c(1,1)= 0.5_RPP ! stencil 1 - case(3) ! 5th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(2,0)= 3._RPP/8._RPP ! stencil 0 - c(0,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= -1._RPP/8._RPP ! stencil 1 - c(0,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(2,2)= 3._RPP/8._RPP ! stencil 2 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(2,0)= 15._RPP/8._RPP ! stencil 0 - c(0,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= 3._RPP/8._RPP ! stencil 1 - c(0,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(2,2)= -1._RPP/8._RPP ! stencil 2 - case(4) ! 7th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 1._RPP/16._RPP; c(1,0)= -5._RPP/16._RPP; c(2,0)= 15._RPP/16._RPP; c(3,0)= 5._RPP/16._RPP ! stencil 0 - c(0,1)= -1._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(3,1)= -1._RPP/16._RPP ! stencil 1 - c(0,2)= 5._RPP/16._RPP; c(1,2)= 15._RPP/16._RPP; c(2,2)= -5._RPP/16._RPP; c(3,2)= 1._RPP/16._RPP ! stencil 2 - c(0,3)= 35._RPP/16._RPP; c(1,3)=-35._RPP/16._RPP; c(2,3)= 21._RPP/16._RPP; c(3,3)= -5._RPP/16._RPP ! stencil 3 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -5._RPP/16._RPP; c(1,0)= 21._RPP/16._RPP; c(2,0)=-35._RPP/16._RPP; c(3,0)= 35._RPP/16._RPP ! stencil 0 - c(0,1)= 1._RPP/16._RPP; c(1,1)= -5._RPP/16._RPP; c(2,1)= 15._RPP/16._RPP; c(3,1)= 5._RPP/16._RPP ! stencil 1 - c(0,2)= -1._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(3,2)= -1._RPP/16._RPP ! stencil 2 - c(0,3)= 5._RPP/16._RPP; c(1,3)= 15._RPP/16._RPP; c(2,3)= -5._RPP/16._RPP; c(3,3)= 1._RPP/16._RPP ! stencil 3 - case(5) ! 9th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -5._RPP/128._RPP; c(1,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(3,0)= 35._RPP/32._RPP ! stencil 0 - c(0,1)= 3._RPP/128._RPP; c(1,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(3,1)= 15._RPP/32._RPP ! stencil 1 - c(0,2)= -5._RPP/128._RPP; c(1,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= -5._RPP/32._RPP ! stencil 2 - c(0,3)= 35._RPP/128._RPP; c(1,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(3,3)= 7._RPP/32._RPP ! stencil 3 - c(0,4)= 315._RPP/128._RPP; c(1,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(3,4)= -45._RPP/32._RPP ! stencil 4 - ! cell 4 - c(4,0)= 35._RPP/128._RPP ! stencil 0 - c(4,1)= -5._RPP/128._RPP ! stencil 1 - c(4,2)= 3._RPP/128._RPP ! stencil 2 - c(4,3)= -5._RPP/128._RPP ! stencil 3 - c(4,4)= 35._RPP/128._RPP ! stencil 4 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 35._RPP/128._RPP; c(1,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(3,0)=-105._RPP/32._RPP ! stencil 0 - c(0,1)= -5._RPP/128._RPP; c(1,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(3,1)= 35._RPP/32._RPP ! stencil 1 - c(0,2)= 3._RPP/128._RPP; c(1,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= 15._RPP/32._RPP ! stencil 2 - c(0,3)= -5._RPP/128._RPP; c(1,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(3,3)= -5._RPP/32._RPP ! stencil 3 - c(0,4)= 35._RPP/128._RPP; c(1,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(3,4)= 7._RPP/32._RPP ! stencil 4 - ! cell 4 - c(4,0)= 315._RPP/128._RPP ! stencil 0 - c(4,1)= 35._RPP/128._RPP ! stencil 1 - c(4,2)= -5._RPP/128._RPP ! stencil 2 - c(4,3)= 3._RPP/128._RPP ! stencil 3 - c(4,4)= -5._RPP/128._RPP ! stencil 4 - case(6) ! 11th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP; c(3,0)= -105._RPP/128._RPP ! stencil 0 - c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP; c(3,1)= 105._RPP/128._RPP ! stencil 1 - c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP; c(3,2)= 75._RPP/128._RPP ! stencil 2 - c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP; c(3,3)= -35._RPP/128._RPP ! stencil 3 - c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP; c(3,4)= 63._RPP/128._RPP ! stencil 4 - c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP; c(3,5)= -495._RPP/128._RPP ! stencil 5 - ! cell 4 ; cell 5 - c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 - c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 - c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 - c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 - c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 - c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP; c(3,0)= 693._RPP/128._RPP ! stencil 0 - c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP; c(3,1)= -105._RPP/128._RPP ! stencil 1 - c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP; c(3,2)= 105._RPP/128._RPP ! stencil 2 - c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP; c(3,3)= 75._RPP/128._RPP ! stencil 3 - c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP; c(3,4)= -35._RPP/128._RPP ! stencil 4 - c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP; c(3,5)= 63._RPP/128._RPP ! stencil 5 - ! cell 4 ; cell 5 - c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 - c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 - c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 - c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 - c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 - c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 - case(7) ! 13th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 - c(0,1)= 7._RPP/1024._RPP; c(1,1)= -27._RPP/512._RPP ; c(2,1)= 189._RPP/1024._RPP ! stencil 1 - c(0,2)= -5._RPP/1024._RPP; c(1,2)= 21._RPP/512._RPP ; c(2,2)= -175._RPP/1024._RPP ! stencil 2 - c(0,3)= 7._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ; c(2,3)= 525._RPP/1024._RPP ! stencil 3 - c(0,4)= -21._RPP/1024._RPP; c(1,4)= 189._RPP/512._RPP ; c(2,4)= 945._RPP/1024._RPP ! stencil 4 - c(0,5)= 231._RPP/1024._RPP; c(1,5)= 693._RPP/512._RPP ; c(2,5)=-1155._RPP/1024._RPP ! stencil 5 - c(0,6)= 3003._RPP/1024._RPP; c(1,6)=-3003._RPP/512._RPP ; c(2,6)= 9009._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 231._RPP/256._RPP ; c(4,0)=-1155._RPP/1024._RPP; c(5,0)= 693._RPP/512._RPP ! stencil 0 - c(3,1)= -105._RPP/256._RPP ; c(4,1)= 945._RPP/1024._RPP; c(5,1)= 189._RPP/512._RPP ! stencil 1 - c(3,2)= 175._RPP/256._RPP ; c(4,2)= 525._RPP/1024._RPP; c(5,2)= -35._RPP/512._RPP ! stencil 2 - c(3,3)= 175._RPP/256._RPP ; c(4,3)= -175._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ! stencil 3 - c(3,4)= -105._RPP/256._RPP ; c(4,4)= 189._RPP/1024._RPP; c(5,4)= -27._RPP/512._RPP ! stencil 4 - c(3,5)= 231._RPP/256._RPP ; c(4,5)= -495._RPP/1024._RPP; c(5,5)= 77._RPP/512._RPP ! stencil 5 - c(3,6)=-2145._RPP/256._RPP ; c(4,6)= 5005._RPP/1024._RPP; c(5,6)= -819._RPP/512._RPP ! stencil 6 - ! cell 6 - c(6,0)= 231._RPP/1024._RPP ! stencil 0 - c(6,1)= -21._RPP/1024._RPP ! stencil 1 - c(6,2)= 7._RPP/1024._RPP ! stencil 2 - c(6,3)= -5._RPP/1024._RPP ! stencil 3 - c(6,4)= 7._RPP/1024._RPP ! stencil 4 - c(6,5)= -21._RPP/1024._RPP ! stencil 5 - c(6,6)= 231._RPP/1024._RPP ! stencil 6 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 - c(0,1)= -21._RPP/1024._RPP; c(1,1)= 77._RPP/512._RPP ; c(2,1)= -495._RPP/1024._RPP ! stencil 1 - c(0,2)= 7._RPP/1024._RPP; c(1,2)= -27._RPP/512._RPP ; c(2,2)= 189._RPP/1024._RPP ! stencil 2 - c(0,3)= -5._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ; c(2,3)= -175._RPP/1024._RPP ! stencil 3 - c(0,4)= 7._RPP/1024._RPP; c(1,4)= -35._RPP/512._RPP ; c(2,4)= 525._RPP/1024._RPP ! stencil 4 - c(0,5)= -21._RPP/1024._RPP; c(1,5)= 189._RPP/512._RPP ; c(2,5)= 945._RPP/1024._RPP ! stencil 5 - c(0,6)= 231._RPP/1024._RPP; c(1,6)= 693._RPP/512._RPP ; c(2,6)=-1155._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)=-2145._RPP/256._RPP ; c(4,0)= 9009._RPP/1024._RPP; c(5,0)=-3003._RPP/512._RPP ! stencil 0 - c(3,1)= 231._RPP/256._RPP ; c(4,1)=-1155._RPP/1024._RPP; c(5,1)= 693._RPP/512._RPP ! stencil 1 - c(3,2)= -105._RPP/256._RPP ; c(4,2)= 945._RPP/1024._RPP; c(5,2)= 189._RPP/512._RPP ! stencil 2 - c(3,3)= 175._RPP/256._RPP ; c(4,3)= 525._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ! stencil 3 - c(3,4)= 175._RPP/256._RPP ; c(4,4)= -175._RPP/1024._RPP; c(5,4)= 21._RPP/512._RPP ! stencil 4 - c(3,5)= -105._RPP/256._RPP ; c(4,5)= 189._RPP/1024._RPP; c(5,5)= -27._RPP/512._RPP ! stencil 5 - c(3,6)= 231._RPP/256._RPP ; c(4,6)= -495._RPP/1024._RPP; c(5,6)= 77._RPP/512._RPP ! stencil 6 - ! cell 6 - c(6,0)= 3003._RPP/1024._RPP ! stencil 0 - c(6,1)= 231._RPP/1024._RPP ! stencil 1 - c(6,2)= -21._RPP/1024._RPP ! stencil 2 - c(6,3)= 7._RPP/1024._RPP ! stencil 3 - c(6,4)= -5._RPP/1024._RPP ! stencil 4 - c(6,5)= 7._RPP/1024._RPP ! stencil 5 - c(6,6)= -21._RPP/1024._RPP ! stencil 6 - case(8) ! 15th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 33._RPP/2048._RPP; c(1,0)= -273._RPP/2048._RPP; c(2,0)= 1001._RPP/2048._RPP ! stencil 0 - c(0,1)= -9._RPP/2048._RPP; c(1,1)= 77._RPP/2048._RPP; c(2,1)= -297._RPP/2048._RPP ! stencil 1 - c(0,2)= 5._RPP/2048._RPP; c(1,2)= -45._RPP/2048._RPP; c(2,2)= 189._RPP/2048._RPP ! stencil 2 - c(0,3)= -5._RPP/2048._RPP; c(1,3)= 49._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 - c(0,4)= 9._RPP/2048._RPP; c(1,4)= -105._RPP/2048._RPP; c(2,4)= 945._RPP/2048._RPP ! stencil 4 - c(0,5)= -33._RPP/2048._RPP; c(1,5)= 693._RPP/2048._RPP; c(2,5)= 2079._RPP/2048._RPP ! stencil 5 - c(0,6)= 429._RPP/2048._RPP; c(1,6)= 3003._RPP/2048._RPP; c(2,6)= -3003._RPP/2048._RPP ! stencil 6 - c(0,7)= 6435._RPP/2048._RPP; c(1,7)=-15015._RPP/2048._RPP; c(2,7)= 27027._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= -2145._RPP/2048._RPP; c(4,0)= 3003._RPP/2048._RPP; c(5,0)= -3003._RPP/2048._RPP ! stencil 0 - c(3,1)= 693._RPP/2048._RPP; c(4,1)= -1155._RPP/2048._RPP; c(5,1)= 2079._RPP/2048._RPP ! stencil 1 - c(3,2)= -525._RPP/2048._RPP; c(4,2)= 1575._RPP/2048._RPP; c(5,2)= 945._RPP/2048._RPP ! stencil 2 - c(3,3)= 1225._RPP/2048._RPP; c(4,3)= 1225._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 - c(3,4)= 1575._RPP/2048._RPP; c(4,4)= -525._RPP/2048._RPP; c(5,4)= 189._RPP/2048._RPP ! stencil 4 - c(3,5)= -1155._RPP/2048._RPP; c(4,5)= 693._RPP/2048._RPP; c(5,5)= -297._RPP/2048._RPP ! stencil 5 - c(3,6)= 3003._RPP/2048._RPP; c(4,6)= -2145._RPP/2048._RPP; c(5,6)= 1001._RPP/2048._RPP ! stencil 6 - c(3,7)=-32175._RPP/2048._RPP; c(4,7)= 25025._RPP/2048._RPP; c(5,7)=-12285._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(6,0)= 3003._RPP/2048._RPP; c(7,0)= 429._RPP/2048._RPP ! stencil 0 - c(6,1)= 693._RPP/2048._RPP; c(7,1)= -33._RPP/2048._RPP ! stencil 1 - c(6,2)= -105._RPP/2048._RPP; c(7,2)= 9._RPP/2048._RPP ! stencil 2 - c(6,3)= 49._RPP/2048._RPP; c(7,3)= -5._RPP/2048._RPP ! stencil 3 - c(6,4)= -45._RPP/2048._RPP; c(7,4)= 5._RPP/2048._RPP ! stencil 4 - c(6,5)= 77._RPP/2048._RPP; c(7,5)= -9._RPP/2048._RPP ! stencil 5 - c(6,6)= -273._RPP/2048._RPP; c(7,6)= 33._RPP/2048._RPP ! stencil 6 - c(6,7)= 3465._RPP/2048._RPP; c(7,7)= -429._RPP/2048._RPP ! stencil 7 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -429._RPP/2048._RPP; c(1,0)= 3465._RPP/2048._RPP; c(2,0)=-12285._RPP/2048._RPP ! stencil 0 - c(0,1)= 33._RPP/2048._RPP; c(1,1)= -273._RPP/2048._RPP; c(2,1)= 1001._RPP/2048._RPP ! stencil 1 - c(0,2)= -9._RPP/2048._RPP; c(1,2)= 77._RPP/2048._RPP; c(2,2)= -297._RPP/2048._RPP ! stencil 2 - c(0,3)= 5._RPP/2048._RPP; c(1,3)= -45._RPP/2048._RPP; c(2,3)= 189._RPP/2048._RPP ! stencil 3 - c(0,4)= -5._RPP/2048._RPP; c(1,4)= 49._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 - c(0,5)= 9._RPP/2048._RPP; c(1,5)= -105._RPP/2048._RPP; c(2,5)= 945._RPP/2048._RPP ! stencil 5 - c(0,6)= -33._RPP/2048._RPP; c(1,6)= 693._RPP/2048._RPP; c(2,6)= 2079._RPP/2048._RPP ! stencil 6 - c(0,7)= 429._RPP/2048._RPP; c(1,7)= 3003._RPP/2048._RPP; c(2,7)= -3003._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 25025._RPP/2048._RPP; c(4,0)=-32175._RPP/2048._RPP; c(5,0)= 27027._RPP/2048._RPP ! stencil 0 - c(3,1)= -2145._RPP/2048._RPP; c(4,1)= 3003._RPP/2048._RPP; c(5,1)= -3003._RPP/2048._RPP ! stencil 1 - c(3,2)= 693._RPP/2048._RPP; c(4,2)= -1155._RPP/2048._RPP; c(5,2)= 2079._RPP/2048._RPP ! stencil 2 - c(3,3)= -525._RPP/2048._RPP; c(4,3)= 1575._RPP/2048._RPP; c(5,3)= 945._RPP/2048._RPP ! stencil 3 - c(3,4)= 1225._RPP/2048._RPP; c(4,4)= 1225._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 - c(3,5)= 1575._RPP/2048._RPP; c(4,5)= -525._RPP/2048._RPP; c(5,5)= 189._RPP/2048._RPP ! stencil 5 - c(3,6)= -1155._RPP/2048._RPP; c(4,6)= 693._RPP/2048._RPP; c(5,6)= -297._RPP/2048._RPP ! stencil 6 - c(3,7)= 3003._RPP/2048._RPP; c(4,7)= -2145._RPP/2048._RPP; c(5,7)= 1001._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(6,0)=-15015._RPP/2048._RPP; c(7,0)= 6435._RPP/2048._RPP ! stencil 0 - c(6,1)= 3003._RPP/2048._RPP; c(7,1)= 429._RPP/2048._RPP ! stencil 1 - c(6,2)= 693._RPP/2048._RPP; c(7,2)= -33._RPP/2048._RPP ! stencil 2 - c(6,3)= -105._RPP/2048._RPP; c(7,3)= 9._RPP/2048._RPP ! stencil 3 - c(6,4)= 49._RPP/2048._RPP; c(7,4)= -5._RPP/2048._RPP ! stencil 4 - c(6,5)= -45._RPP/2048._RPP; c(7,5)= 5._RPP/2048._RPP ! stencil 5 - c(6,6)= 77._RPP/2048._RPP; c(7,6)= -9._RPP/2048._RPP ! stencil 6 - c(6,7)= -273._RPP/2048._RPP; c(7,7)= 33._RPP/2048._RPP ! stencil 7 - case(9) ! 17th order - ! 1 => left interface (i-1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -429._RPP/32768._RPP; c(1,0)= 495._RPP/4096._RPP ; c(2,0)= -4095._RPP/8192._RPP ! stencil 0 - c(0,1)= 99._RPP/32768._RPP; c(1,1)= -117._RPP/4096._RPP ; c(2,1)= 1001._RPP/8192._RPP ! stencil 1 - c(0,2)= -45._RPP/32768._RPP; c(1,2)= 55._RPP/4096._RPP ; c(2,2)= -495._RPP/8192._RPP ! stencil 2 - c(0,3)= 35._RPP/32768._RPP; c(1,3)= -45._RPP/4096._RPP ; c(2,3)= 441._RPP/8192._RPP ! stencil 3 - c(0,4)= -45._RPP/32768._RPP; c(1,4)= 63._RPP/4096._RPP ; c(2,4)= -735._RPP/8192._RPP ! stencil 4 - c(0,5)= 99._RPP/32768._RPP; c(1,5)= -165._RPP/4096._RPP ; c(2,5)= 3465._RPP/8192._RPP ! stencil 5 - c(0,6)= -429._RPP/32768._RPP; c(1,6)= 1287._RPP/4096._RPP ; c(2,6)= 9009._RPP/8192._RPP ! stencil 6 - c(0,7)= 6435._RPP/32768._RPP; c(1,7)= 6435._RPP/4096._RPP ; c(2,7)= -15015._RPP/8192._RPP ! stencil 7 - c(0,8)= 109395._RPP/32768._RPP; c(1,8)= -36465._RPP/4096._RPP ; c(2,8)= 153153._RPP/8192._RPP ! stencil 8 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(5,0)= 9009._RPP/4096._RPP ! stencil 0 - c(3,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(5,1)= -3003._RPP/4096._RPP ! stencil 1 - c(3,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(5,2)= 3465._RPP/4096._RPP ! stencil 2 - c(3,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(5,3)= 2205._RPP/4096._RPP ! stencil 3 - c(3,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= -735._RPP/4096._RPP ! stencil 4 - c(3,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(5,5)= 693._RPP/4096._RPP ! stencil 5 - c(3,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(5,6)= -1287._RPP/4096._RPP ! stencil 6 - c(3,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(5,7)= 5005._RPP/4096._RPP ! stencil 7 - c(3,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(5,8)= -69615._RPP/4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(6,0)= -15015._RPP/8192._RPP ; c(7,0)= 6435._RPP/4096._RPP ; c(8,0)= 6435._RPP/32768._RPP ! stencil 0 - c(6,1)= 9009._RPP/8192._RPP ; c(7,1)= 1287._RPP/4096._RPP ; c(8,1)= -429._RPP/32768._RPP ! stencil 1 - c(6,2)= 3465._RPP/8192._RPP ; c(7,2)= -165._RPP/4096._RPP ; c(8,2)= 99._RPP/32768._RPP ! stencil 2 - c(6,3)= -735._RPP/8192._RPP ; c(7,3)= 63._RPP/4096._RPP ; c(8,3)= -45._RPP/32768._RPP ! stencil 3 - c(6,4)= 441._RPP/8192._RPP ; c(7,4)= -45._RPP/4096._RPP ; c(8,4)= 35._RPP/32768._RPP ! stencil 4 - c(6,5)= -495._RPP/8192._RPP ; c(7,5)= 55._RPP/4096._RPP ; c(8,5)= -45._RPP/32768._RPP ! stencil 5 - c(6,6)= 1001._RPP/8192._RPP ; c(7,6)= -117._RPP/4096._RPP ; c(8,6)= 99._RPP/32768._RPP ! stencil 6 - c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 - c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 - ! 2 => right interface (i+1/2) - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 6435._RPP/32768._RPP; c(1,0)= -7293._RPP/ 4096._RPP; c(2,0)= 58905._RPP/ 8192._RPP ! stencil 0 - c(0,1)= -429._RPP/32768._RPP; c(1,1)= 495._RPP/ 4096._RPP; c(2,1)= -4095._RPP/ 8192._RPP ! stencil 1 - c(0,2)= 99._RPP/32768._RPP; c(1,2)= -117._RPP/ 4096._RPP; c(2,2)= 1001._RPP/ 8192._RPP ! stencil 2 - c(0,3)= -45._RPP/32768._RPP; c(1,3)= 55._RPP/ 4096._RPP; c(2,3)= -495._RPP/ 8192._RPP ! stencil 3 - c(0,4)= 35._RPP/32768._RPP; c(1,4)= -45._RPP/ 4096._RPP; c(2,4)= 441._RPP/ 8192._RPP ! stencil 4 - c(0,5)= -45._RPP/32768._RPP; c(1,5)= 63._RPP/ 4096._RPP; c(2,5)= -735._RPP/ 8192._RPP ! stencil 5 - c(0,6)= 99._RPP/32768._RPP; c(1,6)= -165._RPP/ 4096._RPP; c(2,6)= 3465._RPP/ 8192._RPP ! stencil 6 - c(0,7)= -429._RPP/32768._RPP; c(1,7)= 1287._RPP/ 4096._RPP; c(2,7)= 9009._RPP/ 8192._RPP ! stencil 7 - c(0,8)= 6435._RPP/32768._RPP; c(1,8)= 6435._RPP/ 4096._RPP; c(2,8)= -15015._RPP/ 8192._RPP ! stencil 8 - ! cell 3 ; ! cell 4 ; cell 5 - c(3,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(5,0)=-109395._RPP/ 4096._RPP ! stencil 0 - c(3,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(5,1)= 9009._RPP/ 4096._RPP ! stencil 1 - c(3,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(5,2)= -3003._RPP/ 4096._RPP ! stencil 2 - c(3,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(5,3)= 3465._RPP/ 4096._RPP ! stencil 3 - c(3,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= 2205._RPP/ 4096._RPP ! stencil 4 - c(3,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(5,5)= -735._RPP/ 4096._RPP ! stencil 5 - c(3,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(5,6)= 693._RPP/ 4096._RPP ! stencil 6 - c(3,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(5,7)= -1287._RPP/ 4096._RPP ! stencil 7 - c(3,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(5,8)= 5005._RPP/ 4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(6,0)= 153153._RPP/ 8192._RPP; c(7,0)= -36465._RPP/ 4096._RPP; c(8,0)= 109395._RPP/32768._RPP ! stencil 0 - c(6,1)= -15015._RPP/ 8192._RPP; c(7,1)= 6435._RPP/ 4096._RPP; c(8,1)= 6435._RPP/32768._RPP ! stencil 1 - c(6,2)= 9009._RPP/ 8192._RPP; c(7,2)= 1287._RPP/ 4096._RPP; c(8,2)= -429._RPP/32768._RPP ! stencil 2 - c(6,3)= 3465._RPP/ 8192._RPP; c(7,3)= -165._RPP/ 4096._RPP; c(8,3)= 99._RPP/32768._RPP ! stencil 3 - c(6,4)= -735._RPP/ 8192._RPP; c(7,4)= 63._RPP/ 4096._RPP; c(8,4)= -45._RPP/32768._RPP ! stencil 4 - c(6,5)= 441._RPP/ 8192._RPP; c(7,5)= -45._RPP/ 4096._RPP; c(8,5)= 35._RPP/32768._RPP ! stencil 5 - c(6,6)= -495._RPP/ 8192._RPP; c(7,6)= 55._RPP/ 4096._RPP; c(8,6)= -45._RPP/32768._RPP ! stencil 6 - c(6,7)= 1001._RPP/ 8192._RPP; c(7,7)= -117._RPP/ 4096._RPP; c(8,7)= 99._RPP/32768._RPP ! stencil 7 - c(6,8)= -4095._RPP/ 8192._RPP; c(7,8)= 495._RPP/ 4096._RPP; c(8,8)= -429._RPP/32768._RPP ! stencil 8 + associate(S => self%S, c => self%coef, stencil => constructor%stencil, x_target => constructor%x_target) + if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then + ! left interface (i-1/2) + select case(S) + case(2) ! 3rd order + ! cell 0 ; cell 1 + c(0,0)= 0.5_RPP; c(1,0)= 0.5_RPP ! stencil 0 + c(0,1)= 1.5_RPP; c(1,1)= -0.5_RPP ! stencil 1 + case(3) ! 5th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(2,0)= 3._RPP/8._RPP ! stencil 0 + c(0,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= -1._RPP/8._RPP ! stencil 1 + c(0,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(2,2)= 3._RPP/8._RPP ! stencil 2 + case(4) ! 7th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 1._RPP/16._RPP; c(1,0)= -5._RPP/16._RPP; c(2,0)= 15._RPP/16._RPP; c(3,0)= 5._RPP/16._RPP ! stencil 0 + c(0,1)= -1._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(3,1)= -1._RPP/16._RPP ! stencil 1 + c(0,2)= 5._RPP/16._RPP; c(1,2)= 15._RPP/16._RPP; c(2,2)= -5._RPP/16._RPP; c(3,2)= 1._RPP/16._RPP ! stencil 2 + c(0,3)= 35._RPP/16._RPP; c(1,3)=-35._RPP/16._RPP; c(2,3)= 21._RPP/16._RPP; c(3,3)= -5._RPP/16._RPP ! stencil 3 + case(5) ! 9th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -5._RPP/128._RPP; c(1,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(3,0)= 35._RPP/32._RPP ! stencil 0 + c(0,1)= 3._RPP/128._RPP; c(1,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(3,1)= 15._RPP/32._RPP ! stencil 1 + c(0,2)= -5._RPP/128._RPP; c(1,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= -5._RPP/32._RPP ! stencil 2 + c(0,3)= 35._RPP/128._RPP; c(1,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(3,3)= 7._RPP/32._RPP ! stencil 3 + c(0,4)= 315._RPP/128._RPP; c(1,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(3,4)= -45._RPP/32._RPP ! stencil 4 + ! cell 4 + c(4,0)= 35._RPP/128._RPP ! stencil 0 + c(4,1)= -5._RPP/128._RPP ! stencil 1 + c(4,2)= 3._RPP/128._RPP ! stencil 2 + c(4,3)= -5._RPP/128._RPP ! stencil 3 + c(4,4)= 35._RPP/128._RPP ! stencil 4 + case(6) ! 11th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP; c(3,0)= -105._RPP/128._RPP ! stencil 0 + c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP; c(3,1)= 105._RPP/128._RPP ! stencil 1 + c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP; c(3,2)= 75._RPP/128._RPP ! stencil 2 + c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP; c(3,3)= -35._RPP/128._RPP ! stencil 3 + c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP; c(3,4)= 63._RPP/128._RPP ! stencil 4 + c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP; c(3,5)= -495._RPP/128._RPP ! stencil 5 + ! cell 4 ; cell 5 + c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 + c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 + c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 + c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 + c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 + c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 + case(7) ! 13th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 + c(0,1)= 7._RPP/1024._RPP; c(1,1)= -27._RPP/512._RPP ; c(2,1)= 189._RPP/1024._RPP ! stencil 1 + c(0,2)= -5._RPP/1024._RPP; c(1,2)= 21._RPP/512._RPP ; c(2,2)= -175._RPP/1024._RPP ! stencil 2 + c(0,3)= 7._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ; c(2,3)= 525._RPP/1024._RPP ! stencil 3 + c(0,4)= -21._RPP/1024._RPP; c(1,4)= 189._RPP/512._RPP ; c(2,4)= 945._RPP/1024._RPP ! stencil 4 + c(0,5)= 231._RPP/1024._RPP; c(1,5)= 693._RPP/512._RPP ; c(2,5)=-1155._RPP/1024._RPP ! stencil 5 + c(0,6)= 3003._RPP/1024._RPP; c(1,6)=-3003._RPP/512._RPP ; c(2,6)= 9009._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 231._RPP/256._RPP ; c(4,0)=-1155._RPP/1024._RPP; c(5,0)= 693._RPP/512._RPP ! stencil 0 + c(3,1)= -105._RPP/256._RPP ; c(4,1)= 945._RPP/1024._RPP; c(5,1)= 189._RPP/512._RPP ! stencil 1 + c(3,2)= 175._RPP/256._RPP ; c(4,2)= 525._RPP/1024._RPP; c(5,2)= -35._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(4,3)= -175._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ! stencil 3 + c(3,4)= -105._RPP/256._RPP ; c(4,4)= 189._RPP/1024._RPP; c(5,4)= -27._RPP/512._RPP ! stencil 4 + c(3,5)= 231._RPP/256._RPP ; c(4,5)= -495._RPP/1024._RPP; c(5,5)= 77._RPP/512._RPP ! stencil 5 + c(3,6)=-2145._RPP/256._RPP ; c(4,6)= 5005._RPP/1024._RPP; c(5,6)= -819._RPP/512._RPP ! stencil 6 + ! cell 6 + c(6,0)= 231._RPP/1024._RPP ! stencil 0 + c(6,1)= -21._RPP/1024._RPP ! stencil 1 + c(6,2)= 7._RPP/1024._RPP ! stencil 2 + c(6,3)= -5._RPP/1024._RPP ! stencil 3 + c(6,4)= 7._RPP/1024._RPP ! stencil 4 + c(6,5)= -21._RPP/1024._RPP ! stencil 5 + c(6,6)= 231._RPP/1024._RPP ! stencil 6 + case(8) ! 15th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 33._RPP/2048._RPP; c(1,0)= -273._RPP/2048._RPP; c(2,0)= 1001._RPP/2048._RPP ! stencil 0 + c(0,1)= -9._RPP/2048._RPP; c(1,1)= 77._RPP/2048._RPP; c(2,1)= -297._RPP/2048._RPP ! stencil 1 + c(0,2)= 5._RPP/2048._RPP; c(1,2)= -45._RPP/2048._RPP; c(2,2)= 189._RPP/2048._RPP ! stencil 2 + c(0,3)= -5._RPP/2048._RPP; c(1,3)= 49._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 + c(0,4)= 9._RPP/2048._RPP; c(1,4)= -105._RPP/2048._RPP; c(2,4)= 945._RPP/2048._RPP ! stencil 4 + c(0,5)= -33._RPP/2048._RPP; c(1,5)= 693._RPP/2048._RPP; c(2,5)= 2079._RPP/2048._RPP ! stencil 5 + c(0,6)= 429._RPP/2048._RPP; c(1,6)= 3003._RPP/2048._RPP; c(2,6)= -3003._RPP/2048._RPP ! stencil 6 + c(0,7)= 6435._RPP/2048._RPP; c(1,7)=-15015._RPP/2048._RPP; c(2,7)= 27027._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= -2145._RPP/2048._RPP; c(4,0)= 3003._RPP/2048._RPP; c(5,0)= -3003._RPP/2048._RPP ! stencil 0 + c(3,1)= 693._RPP/2048._RPP; c(4,1)= -1155._RPP/2048._RPP; c(5,1)= 2079._RPP/2048._RPP ! stencil 1 + c(3,2)= -525._RPP/2048._RPP; c(4,2)= 1575._RPP/2048._RPP; c(5,2)= 945._RPP/2048._RPP ! stencil 2 + c(3,3)= 1225._RPP/2048._RPP; c(4,3)= 1225._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 + c(3,4)= 1575._RPP/2048._RPP; c(4,4)= -525._RPP/2048._RPP; c(5,4)= 189._RPP/2048._RPP ! stencil 4 + c(3,5)= -1155._RPP/2048._RPP; c(4,5)= 693._RPP/2048._RPP; c(5,5)= -297._RPP/2048._RPP ! stencil 5 + c(3,6)= 3003._RPP/2048._RPP; c(4,6)= -2145._RPP/2048._RPP; c(5,6)= 1001._RPP/2048._RPP ! stencil 6 + c(3,7)=-32175._RPP/2048._RPP; c(4,7)= 25025._RPP/2048._RPP; c(5,7)=-12285._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(6,0)= 3003._RPP/2048._RPP; c(7,0)= 429._RPP/2048._RPP ! stencil 0 + c(6,1)= 693._RPP/2048._RPP; c(7,1)= -33._RPP/2048._RPP ! stencil 1 + c(6,2)= -105._RPP/2048._RPP; c(7,2)= 9._RPP/2048._RPP ! stencil 2 + c(6,3)= 49._RPP/2048._RPP; c(7,3)= -5._RPP/2048._RPP ! stencil 3 + c(6,4)= -45._RPP/2048._RPP; c(7,4)= 5._RPP/2048._RPP ! stencil 4 + c(6,5)= 77._RPP/2048._RPP; c(7,5)= -9._RPP/2048._RPP ! stencil 5 + c(6,6)= -273._RPP/2048._RPP; c(7,6)= 33._RPP/2048._RPP ! stencil 6 + c(6,7)= 3465._RPP/2048._RPP; c(7,7)= -429._RPP/2048._RPP ! stencil 7 + case(9) ! 17th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -429._RPP/32768._RPP; c(1,0)= 495._RPP/4096._RPP ; c(2,0)= -4095._RPP/8192._RPP ! stencil 0 + c(0,1)= 99._RPP/32768._RPP; c(1,1)= -117._RPP/4096._RPP ; c(2,1)= 1001._RPP/8192._RPP ! stencil 1 + c(0,2)= -45._RPP/32768._RPP; c(1,2)= 55._RPP/4096._RPP ; c(2,2)= -495._RPP/8192._RPP ! stencil 2 + c(0,3)= 35._RPP/32768._RPP; c(1,3)= -45._RPP/4096._RPP ; c(2,3)= 441._RPP/8192._RPP ! stencil 3 + c(0,4)= -45._RPP/32768._RPP; c(1,4)= 63._RPP/4096._RPP ; c(2,4)= -735._RPP/8192._RPP ! stencil 4 + c(0,5)= 99._RPP/32768._RPP; c(1,5)= -165._RPP/4096._RPP ; c(2,5)= 3465._RPP/8192._RPP ! stencil 5 + c(0,6)= -429._RPP/32768._RPP; c(1,6)= 1287._RPP/4096._RPP ; c(2,6)= 9009._RPP/8192._RPP ! stencil 6 + c(0,7)= 6435._RPP/32768._RPP; c(1,7)= 6435._RPP/4096._RPP ; c(2,7)= -15015._RPP/8192._RPP ! stencil 7 + c(0,8)= 109395._RPP/32768._RPP; c(1,8)= -36465._RPP/4096._RPP ; c(2,8)= 153153._RPP/8192._RPP ! stencil 8 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(5,0)= 9009._RPP/4096._RPP ! stencil 0 + c(3,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(5,1)= -3003._RPP/4096._RPP ! stencil 1 + c(3,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(5,2)= 3465._RPP/4096._RPP ! stencil 2 + c(3,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(5,3)= 2205._RPP/4096._RPP ! stencil 3 + c(3,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= -735._RPP/4096._RPP ! stencil 4 + c(3,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(5,5)= 693._RPP/4096._RPP ! stencil 5 + c(3,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(5,6)= -1287._RPP/4096._RPP ! stencil 6 + c(3,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(5,7)= 5005._RPP/4096._RPP ! stencil 7 + c(3,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(5,8)= -69615._RPP/4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(6,0)= -15015._RPP/8192._RPP ; c(7,0)= 6435._RPP/4096._RPP ; c(8,0)= 6435._RPP/32768._RPP ! stencil 0 + c(6,1)= 9009._RPP/8192._RPP ; c(7,1)= 1287._RPP/4096._RPP ; c(8,1)= -429._RPP/32768._RPP ! stencil 1 + c(6,2)= 3465._RPP/8192._RPP ; c(7,2)= -165._RPP/4096._RPP ; c(8,2)= 99._RPP/32768._RPP ! stencil 2 + c(6,3)= -735._RPP/8192._RPP ; c(7,3)= 63._RPP/4096._RPP ; c(8,3)= -45._RPP/32768._RPP ! stencil 3 + c(6,4)= 441._RPP/8192._RPP ; c(7,4)= -45._RPP/4096._RPP ; c(8,4)= 35._RPP/32768._RPP ! stencil 4 + c(6,5)= -495._RPP/8192._RPP ; c(7,5)= 55._RPP/4096._RPP ; c(8,5)= -45._RPP/32768._RPP ! stencil 5 + c(6,6)= 1001._RPP/8192._RPP ; c(7,6)= -117._RPP/4096._RPP ; c(8,6)= 99._RPP/32768._RPP ! stencil 6 + c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 + c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 endselect + elseif((x_target-(stencil(0)+stencil(1))/2._RPP)<10._RPP**(-10)) then + ! right interface (i+1/2) + select case(self%S) + case(2) ! 3rd order + ! cell 0 ; cell 1 + c(0,0)= -0.5_RPP; c(1,0)= 1.5_RPP ! stencil 0 + c(0,1)= 0.5_RPP; c(1,1)= 0.5_RPP ! stencil 1 + case(3) ! 5th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(2,0)= 15._RPP/8._RPP ! stencil 0 + c(0,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= 3._RPP/8._RPP ! stencil 1 + c(0,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(2,2)= -1._RPP/8._RPP ! stencil 2 + case(4) ! 7th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -5._RPP/16._RPP; c(1,0)= 21._RPP/16._RPP; c(2,0)=-35._RPP/16._RPP; c(3,0)= 35._RPP/16._RPP ! stencil 0 + c(0,1)= 1._RPP/16._RPP; c(1,1)= -5._RPP/16._RPP; c(2,1)= 15._RPP/16._RPP; c(3,1)= 5._RPP/16._RPP ! stencil 1 + c(0,2)= -1._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(3,2)= -1._RPP/16._RPP ! stencil 2 + c(0,3)= 5._RPP/16._RPP; c(1,3)= 15._RPP/16._RPP; c(2,3)= -5._RPP/16._RPP; c(3,3)= 1._RPP/16._RPP ! stencil 3 + case(5) ! 9th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 35._RPP/128._RPP; c(1,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(3,0)=-105._RPP/32._RPP ! stencil 0 + c(0,1)= -5._RPP/128._RPP; c(1,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(3,1)= 35._RPP/32._RPP ! stencil 1 + c(0,2)= 3._RPP/128._RPP; c(1,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= 15._RPP/32._RPP ! stencil 2 + c(0,3)= -5._RPP/128._RPP; c(1,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(3,3)= -5._RPP/32._RPP ! stencil 3 + c(0,4)= 35._RPP/128._RPP; c(1,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(3,4)= 7._RPP/32._RPP ! stencil 4 + ! cell 4 + c(4,0)= 315._RPP/128._RPP ! stencil 0 + c(4,1)= 35._RPP/128._RPP ! stencil 1 + c(4,2)= -5._RPP/128._RPP ! stencil 2 + c(4,3)= 3._RPP/128._RPP ! stencil 3 + c(4,4)= -5._RPP/128._RPP ! stencil 4 + case(6) ! 11th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP; c(3,0)= 693._RPP/128._RPP ! stencil 0 + c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP; c(3,1)= -105._RPP/128._RPP ! stencil 1 + c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP; c(3,2)= 105._RPP/128._RPP ! stencil 2 + c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP; c(3,3)= 75._RPP/128._RPP ! stencil 3 + c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP; c(3,4)= -35._RPP/128._RPP ! stencil 4 + c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP; c(3,5)= 63._RPP/128._RPP ! stencil 5 + ! cell 4 ; cell 5 + c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 + c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 + c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 + c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 + c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 + c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 + case(7) ! 13th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 + c(0,1)= -21._RPP/1024._RPP; c(1,1)= 77._RPP/512._RPP ; c(2,1)= -495._RPP/1024._RPP ! stencil 1 + c(0,2)= 7._RPP/1024._RPP; c(1,2)= -27._RPP/512._RPP ; c(2,2)= 189._RPP/1024._RPP ! stencil 2 + c(0,3)= -5._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ; c(2,3)= -175._RPP/1024._RPP ! stencil 3 + c(0,4)= 7._RPP/1024._RPP; c(1,4)= -35._RPP/512._RPP ; c(2,4)= 525._RPP/1024._RPP ! stencil 4 + c(0,5)= -21._RPP/1024._RPP; c(1,5)= 189._RPP/512._RPP ; c(2,5)= 945._RPP/1024._RPP ! stencil 5 + c(0,6)= 231._RPP/1024._RPP; c(1,6)= 693._RPP/512._RPP ; c(2,6)=-1155._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)=-2145._RPP/256._RPP ; c(4,0)= 9009._RPP/1024._RPP; c(5,0)=-3003._RPP/512._RPP ! stencil 0 + c(3,1)= 231._RPP/256._RPP ; c(4,1)=-1155._RPP/1024._RPP; c(5,1)= 693._RPP/512._RPP ! stencil 1 + c(3,2)= -105._RPP/256._RPP ; c(4,2)= 945._RPP/1024._RPP; c(5,2)= 189._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(4,3)= 525._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ! stencil 3 + c(3,4)= 175._RPP/256._RPP ; c(4,4)= -175._RPP/1024._RPP; c(5,4)= 21._RPP/512._RPP ! stencil 4 + c(3,5)= -105._RPP/256._RPP ; c(4,5)= 189._RPP/1024._RPP; c(5,5)= -27._RPP/512._RPP ! stencil 5 + c(3,6)= 231._RPP/256._RPP ; c(4,6)= -495._RPP/1024._RPP; c(5,6)= 77._RPP/512._RPP ! stencil 6 + ! cell 6 + c(6,0)= 3003._RPP/1024._RPP ! stencil 0 + c(6,1)= 231._RPP/1024._RPP ! stencil 1 + c(6,2)= -21._RPP/1024._RPP ! stencil 2 + c(6,3)= 7._RPP/1024._RPP ! stencil 3 + c(6,4)= -5._RPP/1024._RPP ! stencil 4 + c(6,5)= 7._RPP/1024._RPP ! stencil 5 + c(6,6)= -21._RPP/1024._RPP ! stencil 6 + case(8) ! 15th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -429._RPP/2048._RPP; c(1,0)= 3465._RPP/2048._RPP; c(2,0)=-12285._RPP/2048._RPP ! stencil 0 + c(0,1)= 33._RPP/2048._RPP; c(1,1)= -273._RPP/2048._RPP; c(2,1)= 1001._RPP/2048._RPP ! stencil 1 + c(0,2)= -9._RPP/2048._RPP; c(1,2)= 77._RPP/2048._RPP; c(2,2)= -297._RPP/2048._RPP ! stencil 2 + c(0,3)= 5._RPP/2048._RPP; c(1,3)= -45._RPP/2048._RPP; c(2,3)= 189._RPP/2048._RPP ! stencil 3 + c(0,4)= -5._RPP/2048._RPP; c(1,4)= 49._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 + c(0,5)= 9._RPP/2048._RPP; c(1,5)= -105._RPP/2048._RPP; c(2,5)= 945._RPP/2048._RPP ! stencil 5 + c(0,6)= -33._RPP/2048._RPP; c(1,6)= 693._RPP/2048._RPP; c(2,6)= 2079._RPP/2048._RPP ! stencil 6 + c(0,7)= 429._RPP/2048._RPP; c(1,7)= 3003._RPP/2048._RPP; c(2,7)= -3003._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 25025._RPP/2048._RPP; c(4,0)=-32175._RPP/2048._RPP; c(5,0)= 27027._RPP/2048._RPP ! stencil 0 + c(3,1)= -2145._RPP/2048._RPP; c(4,1)= 3003._RPP/2048._RPP; c(5,1)= -3003._RPP/2048._RPP ! stencil 1 + c(3,2)= 693._RPP/2048._RPP; c(4,2)= -1155._RPP/2048._RPP; c(5,2)= 2079._RPP/2048._RPP ! stencil 2 + c(3,3)= -525._RPP/2048._RPP; c(4,3)= 1575._RPP/2048._RPP; c(5,3)= 945._RPP/2048._RPP ! stencil 3 + c(3,4)= 1225._RPP/2048._RPP; c(4,4)= 1225._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 + c(3,5)= 1575._RPP/2048._RPP; c(4,5)= -525._RPP/2048._RPP; c(5,5)= 189._RPP/2048._RPP ! stencil 5 + c(3,6)= -1155._RPP/2048._RPP; c(4,6)= 693._RPP/2048._RPP; c(5,6)= -297._RPP/2048._RPP ! stencil 6 + c(3,7)= 3003._RPP/2048._RPP; c(4,7)= -2145._RPP/2048._RPP; c(5,7)= 1001._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(6,0)=-15015._RPP/2048._RPP; c(7,0)= 6435._RPP/2048._RPP ! stencil 0 + c(6,1)= 3003._RPP/2048._RPP; c(7,1)= 429._RPP/2048._RPP ! stencil 1 + c(6,2)= 693._RPP/2048._RPP; c(7,2)= -33._RPP/2048._RPP ! stencil 2 + c(6,3)= -105._RPP/2048._RPP; c(7,3)= 9._RPP/2048._RPP ! stencil 3 + c(6,4)= 49._RPP/2048._RPP; c(7,4)= -5._RPP/2048._RPP ! stencil 4 + c(6,5)= -45._RPP/2048._RPP; c(7,5)= 5._RPP/2048._RPP ! stencil 5 + c(6,6)= 77._RPP/2048._RPP; c(7,6)= -9._RPP/2048._RPP ! stencil 6 + c(6,7)= -273._RPP/2048._RPP; c(7,7)= 33._RPP/2048._RPP ! stencil 7 + case(9) ! 17th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 6435._RPP/32768._RPP; c(1,0)= -7293._RPP/ 4096._RPP; c(2,0)= 58905._RPP/ 8192._RPP ! stencil 0 + c(0,1)= -429._RPP/32768._RPP; c(1,1)= 495._RPP/ 4096._RPP; c(2,1)= -4095._RPP/ 8192._RPP ! stencil 1 + c(0,2)= 99._RPP/32768._RPP; c(1,2)= -117._RPP/ 4096._RPP; c(2,2)= 1001._RPP/ 8192._RPP ! stencil 2 + c(0,3)= -45._RPP/32768._RPP; c(1,3)= 55._RPP/ 4096._RPP; c(2,3)= -495._RPP/ 8192._RPP ! stencil 3 + c(0,4)= 35._RPP/32768._RPP; c(1,4)= -45._RPP/ 4096._RPP; c(2,4)= 441._RPP/ 8192._RPP ! stencil 4 + c(0,5)= -45._RPP/32768._RPP; c(1,5)= 63._RPP/ 4096._RPP; c(2,5)= -735._RPP/ 8192._RPP ! stencil 5 + c(0,6)= 99._RPP/32768._RPP; c(1,6)= -165._RPP/ 4096._RPP; c(2,6)= 3465._RPP/ 8192._RPP ! stencil 6 + c(0,7)= -429._RPP/32768._RPP; c(1,7)= 1287._RPP/ 4096._RPP; c(2,7)= 9009._RPP/ 8192._RPP ! stencil 7 + c(0,8)= 6435._RPP/32768._RPP; c(1,8)= 6435._RPP/ 4096._RPP; c(2,8)= -15015._RPP/ 8192._RPP ! stencil 8 + ! cell 3 ; ! cell 4 ; cell 5 + c(3,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(5,0)=-109395._RPP/ 4096._RPP ! stencil 0 + c(3,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(5,1)= 9009._RPP/ 4096._RPP ! stencil 1 + c(3,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(5,2)= -3003._RPP/ 4096._RPP ! stencil 2 + c(3,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(5,3)= 3465._RPP/ 4096._RPP ! stencil 3 + c(3,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= 2205._RPP/ 4096._RPP ! stencil 4 + c(3,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(5,5)= -735._RPP/ 4096._RPP ! stencil 5 + c(3,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(5,6)= 693._RPP/ 4096._RPP ! stencil 6 + c(3,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(5,7)= -1287._RPP/ 4096._RPP ! stencil 7 + c(3,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(5,8)= 5005._RPP/ 4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(6,0)= 153153._RPP/ 8192._RPP; c(7,0)= -36465._RPP/ 4096._RPP; c(8,0)= 109395._RPP/32768._RPP ! stencil 0 + c(6,1)= -15015._RPP/ 8192._RPP; c(7,1)= 6435._RPP/ 4096._RPP; c(8,1)= 6435._RPP/32768._RPP ! stencil 1 + c(6,2)= 9009._RPP/ 8192._RPP; c(7,2)= 1287._RPP/ 4096._RPP; c(8,2)= -429._RPP/32768._RPP ! stencil 2 + c(6,3)= 3465._RPP/ 8192._RPP; c(7,3)= -165._RPP/ 4096._RPP; c(8,3)= 99._RPP/32768._RPP ! stencil 3 + c(6,4)= -735._RPP/ 8192._RPP; c(7,4)= 63._RPP/ 4096._RPP; c(8,4)= -45._RPP/32768._RPP ! stencil 4 + c(6,5)= 441._RPP/ 8192._RPP; c(7,5)= -45._RPP/ 4096._RPP; c(8,5)= 35._RPP/32768._RPP ! stencil 5 + c(6,6)= -495._RPP/ 8192._RPP; c(7,6)= 55._RPP/ 4096._RPP; c(8,6)= -45._RPP/32768._RPP ! stencil 6 + c(6,7)= 1001._RPP/ 8192._RPP; c(7,7)= -117._RPP/ 4096._RPP; c(8,7)= 99._RPP/32768._RPP ! stencil 7 + c(6,8)= -4095._RPP/ 8192._RPP; c(7,8)= 495._RPP/ 4096._RPP; c(8,8)= -429._RPP/32768._RPP ! stencil 8 + endselect + else + ! internal point + do k=0,S-1 !stencils loop + do j=0,S-1 !values loop + prod = 1._RPP + do i=0,S-1 + if (i==j) cycle + prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j+1) - stencil(-S+k+i+1))) + enddo + c(j,k) = prod + enddo + enddo + endif endassociate endsubroutine create diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index d935487..2814c2c 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -15,8 +15,9 @@ module wenoof_interpolations_factory !< Factory, create an instance of concrete extension of [[interpolations_object]] given its constructor. contains ! public methods - procedure, nopass :: create !< Create a concrete instance of [[interpolations_object]]. - procedure, nopass :: create_constructor !< Create a concrete instance of [[interpolations_object_constructor]]. + procedure, nopass :: create !< Create a concrete instance of [[interpolations_object]]. + procedure, nopass, generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance + create_constructor_int !< of [[interpolations_object_constructor]]. endtype interpolations_factory contains @@ -36,24 +37,27 @@ subroutine create(constructor, object) call object%create(constructor=constructor) endsubroutine create - subroutine create_constructor(interpolator_type, S, constructor) + subroutine create_constructor_rec(interpolator_type, S, constructor) !< Create an instance of concrete extension of [[beta_object_constructor]]. - character(*), intent(in) :: interpolator_type !< Type of the interpolator. - integer(I_P), intent(in) :: S !< Stencils dimension. - class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - - select case(trim(adjustl(interpolator_type))) - case('interpolator-JS') - allocate(interpolations_int_js_constructor :: constructor) - case('reconstructor-JS') - allocate(interpolations_rec_js_constructor :: constructor) - case('reconstructor-M-JS') - allocate(interpolations_rec_js_constructor :: constructor) - case('reconstructor-M-Z') - allocate(interpolations_rec_js_constructor :: constructor) - case('reconstructor-Z') - allocate(interpolations_rec_js_constructor :: constructor) - endselect + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + + allocate(interpolations_rec_js_constructor :: constructor) + call constructor%create(S=S) + endsubroutine create_constructor_rec + + subroutine create_constructor(interpolator_type, S, stencil, x_target, constructor) + !< Create an instance of concrete extension of [[beta_object_constructor]]. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. + class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + + allocate(interpolations_int_js_constructor :: constructor) + allocate(stencil :: constructor%stencil) + constructor%x_target = x_target call constructor%create(S=S) endsubroutine create_constructor endmodule wenoof_interpolations_factory diff --git a/src/lib/factories/wenoof_objects_factory.f90 b/src/lib/factories/wenoof_objects_factory.f90 index 6b4516f..1461548 100644 --- a/src/lib/factories/wenoof_objects_factory.f90 +++ b/src/lib/factories/wenoof_objects_factory.f90 @@ -174,6 +174,12 @@ subroutine create_interpolator(self, interpolator_type, S, interpolator, stencil S=S, & constructor=beta_constructor) + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + stencil=stencil, & + x_target=x_target, & + constructor=interpolations_constructor) + call self%create_constructor(interpolator_type=interpolator_type, & S=S, & stencil=stencil, & @@ -187,12 +193,6 @@ subroutine create_interpolator(self, interpolator_type, S, interpolator, stencil kappa_constructor=kappa_constructor, & constructor=weights_constructor) - call self%create_constructor(interpolator_type=interpolator_type, & - S=S, & - stencil=stencil, & - x_target=x_target, & - constructor=interpolations_constructor) - call self%create_constructor(interpolator_type=interpolator_type, & S=S, & interpolations_constructor=interpolations_constructor, & From 57ef6e5127f2a3dad879c36ec0f75bcadb93fc45 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 17:26:08 +0100 Subject: [PATCH 41/90] deleted unnecessary blank line --- src/lib/factories/wenoof_kappa_factory.f90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/factories/wenoof_kappa_factory.f90 b/src/lib/factories/wenoof_kappa_factory.f90 index ade38ec..4e7f689 100644 --- a/src/lib/factories/wenoof_kappa_factory.f90 +++ b/src/lib/factories/wenoof_kappa_factory.f90 @@ -18,7 +18,6 @@ module wenoof_kappa_factory procedure, nopass :: create !< Create a concrete instance of [[kappa_object]]. procedure, nopass, generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance create_constructor_int !< of [[kappa_object_constructor]]. - endtype kappa_factory contains From c49b3419580ec3f7d3a0451384225923436d3232 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 17:26:37 +0100 Subject: [PATCH 42/90] update PENF to last commit --- src/third_party/PENF | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/third_party/PENF b/src/third_party/PENF index e4ddeb2..cfafeea 160000 --- a/src/third_party/PENF +++ b/src/third_party/PENF @@ -1 +1 @@ -Subproject commit e4ddeb2c3f02047a371f909b4e0e69a2926550a2 +Subproject commit cfafeeacc2dcef861f03fc9f7e287997df9aa139 From 6513333526ef485f376ebaed28c080d87228bbc2 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 17:48:05 +0100 Subject: [PATCH 43/90] add RPP to import statement --- src/lib/abstract_objects/wenoof_kappa_object.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index d7b561c..76427c9 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -40,7 +40,7 @@ pure subroutine compute_kappa_rec_interface(self) pure subroutine compute_kappa_int_interface(self, stencil, x_target) !< Compute kappa. - import :: kappa_object + import :: kappa_object, RPP class(kappa_object), intent(inout) :: self !< Kappa. real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. From 2f788870fd221b3dc104902ebad7819013f96f06 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 2 Mar 2017 17:49:05 +0100 Subject: [PATCH 44/90] add variables to subroutine preamble --- src/lib/concrete_objects/wenoof_interpolations_int_js.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index 8040111..ea45f52 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -48,6 +48,8 @@ subroutine create(self, constructor) !< Create interpolations. class(interpolations_int_js), intent(inout) :: self !< Interpolations. class(base_object_constructor), intent(in) :: constructor !< Interpolations constructor. + real(RPP) :: prod !< Temporary variable. + integer(I_P) :: i, j, k !< Counters. call self%destroy call self%create_(constructor=constructor) From 6ace112ea94ff4291aba88bfaf0b3ecef617a482 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 3 Mar 2017 09:20:31 +0100 Subject: [PATCH 45/90] fix line lenght --- .../wenoof_interpolations_int_js.F90 | 56 +++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index ea45f52..c344793 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -89,20 +89,20 @@ subroutine create(self, constructor) c(4,3)= -5._RPP/128._RPP ! stencil 3 c(4,4)= 35._RPP/128._RPP ! stencil 4 case(6) ! 11th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP; c(3,0)= -105._RPP/128._RPP ! stencil 0 - c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP; c(3,1)= 105._RPP/128._RPP ! stencil 1 - c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP; c(3,2)= 75._RPP/128._RPP ! stencil 2 - c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP; c(3,3)= -35._RPP/128._RPP ! stencil 3 - c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP; c(3,4)= 63._RPP/128._RPP ! stencil 4 - c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP; c(3,5)= -495._RPP/128._RPP ! stencil 5 - ! cell 4 ; cell 5 - c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 - c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 - c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 - c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 - c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 - c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP ! stencil 0 + c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP ! stencil 1 + c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP ! stencil 2 + c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP ! stencil 3 + c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP ! stencil 4 + c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP ! stencil 5 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= -105._RPP/128._RPP; c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 + c(3,1)= 105._RPP/128._RPP; c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 + c(3,2)= 75._RPP/128._RPP; c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 + c(3,3)= -35._RPP/128._RPP; c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 + c(3,4)= 63._RPP/128._RPP; c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 + c(3,5)= -495._RPP/128._RPP; c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 case(7) ! 13th order ! cell 0 ; cell 1 ; cell 2 c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 @@ -220,20 +220,20 @@ subroutine create(self, constructor) c(4,3)= 3._RPP/128._RPP ! stencil 3 c(4,4)= -5._RPP/128._RPP ! stencil 4 case(6) ! 11th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP; c(3,0)= 693._RPP/128._RPP ! stencil 0 - c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP; c(3,1)= -105._RPP/128._RPP ! stencil 1 - c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP; c(3,2)= 105._RPP/128._RPP ! stencil 2 - c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP; c(3,3)= 75._RPP/128._RPP ! stencil 3 - c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP; c(3,4)= -35._RPP/128._RPP ! stencil 4 - c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP; c(3,5)= 63._RPP/128._RPP ! stencil 5 - ! cell 4 ; cell 5 - c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 - c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 - c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 - c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 - c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 - c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP ! stencil 0 + c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP ! stencil 1 + c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP ! stencil 2 + c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP ! stencil 3 + c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP ! stencil 4 + c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP ! stencil 5 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 693._RPP/128._RPP; c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 + c(3,1)= -105._RPP/128._RPP; c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 + c(3,2)= 105._RPP/128._RPP; c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 + c(3,3)= 75._RPP/128._RPP; c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 + c(3,4)= -35._RPP/128._RPP; c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 + c(3,5)= 63._RPP/128._RPP; c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 case(7) ! 13th order ! cell 0 ; cell 1 ; cell 2 c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 From f1ca782fd937487437a816872bfcf32dd9ef46a8 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 3 Mar 2017 13:06:06 +0100 Subject: [PATCH 46/90] fix bugs --- .../wenoof_interpolations_int_js.F90 | 554 +++++++++--------- .../concrete_objects/wenoof_kappa_int_js.F90 | 30 +- .../concrete_objects/wenoof_kappa_rec_js.F90 | 18 +- .../wenoof_interpolations_factory.f90 | 4 +- 4 files changed, 312 insertions(+), 294 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index c344793..f993854 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -31,7 +31,6 @@ module wenoof_interpolations_int_js !< @note The provided interpolations implement the Lagrange interpolations defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. - private real(RPP), allocatable :: coef(:,:) !< Polynomial coefficients [0:S-1,0:S-1]. contains ! public deferred methods @@ -56,283 +55,286 @@ subroutine create(self, constructor) allocate(self%values_rank_1(0:self%S - 1)) self%values_rank_1 = 0._RPP allocate(self%coef(0:self%S - 1, 0:self%S - 1)) - associate(S => self%S, c => self%coef, stencil => constructor%stencil, x_target => constructor%x_target) - if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then - ! left interface (i-1/2) - select case(S) - case(2) ! 3rd order - ! cell 0 ; cell 1 - c(0,0)= 0.5_RPP; c(1,0)= 0.5_RPP ! stencil 0 - c(0,1)= 1.5_RPP; c(1,1)= -0.5_RPP ! stencil 1 - case(3) ! 5th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(2,0)= 3._RPP/8._RPP ! stencil 0 - c(0,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= -1._RPP/8._RPP ! stencil 1 - c(0,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(2,2)= 3._RPP/8._RPP ! stencil 2 - case(4) ! 7th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 1._RPP/16._RPP; c(1,0)= -5._RPP/16._RPP; c(2,0)= 15._RPP/16._RPP; c(3,0)= 5._RPP/16._RPP ! stencil 0 - c(0,1)= -1._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(3,1)= -1._RPP/16._RPP ! stencil 1 - c(0,2)= 5._RPP/16._RPP; c(1,2)= 15._RPP/16._RPP; c(2,2)= -5._RPP/16._RPP; c(3,2)= 1._RPP/16._RPP ! stencil 2 - c(0,3)= 35._RPP/16._RPP; c(1,3)=-35._RPP/16._RPP; c(2,3)= 21._RPP/16._RPP; c(3,3)= -5._RPP/16._RPP ! stencil 3 - case(5) ! 9th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -5._RPP/128._RPP; c(1,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(3,0)= 35._RPP/32._RPP ! stencil 0 - c(0,1)= 3._RPP/128._RPP; c(1,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(3,1)= 15._RPP/32._RPP ! stencil 1 - c(0,2)= -5._RPP/128._RPP; c(1,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= -5._RPP/32._RPP ! stencil 2 - c(0,3)= 35._RPP/128._RPP; c(1,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(3,3)= 7._RPP/32._RPP ! stencil 3 - c(0,4)= 315._RPP/128._RPP; c(1,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(3,4)= -45._RPP/32._RPP ! stencil 4 - ! cell 4 - c(4,0)= 35._RPP/128._RPP ! stencil 0 - c(4,1)= -5._RPP/128._RPP ! stencil 1 - c(4,2)= 3._RPP/128._RPP ! stencil 2 - c(4,3)= -5._RPP/128._RPP ! stencil 3 - c(4,4)= 35._RPP/128._RPP ! stencil 4 - case(6) ! 11th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP ! stencil 0 - c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP ! stencil 1 - c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP ! stencil 2 - c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP ! stencil 3 - c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP ! stencil 4 - c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP ! stencil 5 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= -105._RPP/128._RPP; c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 - c(3,1)= 105._RPP/128._RPP; c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 - c(3,2)= 75._RPP/128._RPP; c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 - c(3,3)= -35._RPP/128._RPP; c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 - c(3,4)= 63._RPP/128._RPP; c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 - c(3,5)= -495._RPP/128._RPP; c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 - case(7) ! 13th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 - c(0,1)= 7._RPP/1024._RPP; c(1,1)= -27._RPP/512._RPP ; c(2,1)= 189._RPP/1024._RPP ! stencil 1 - c(0,2)= -5._RPP/1024._RPP; c(1,2)= 21._RPP/512._RPP ; c(2,2)= -175._RPP/1024._RPP ! stencil 2 - c(0,3)= 7._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ; c(2,3)= 525._RPP/1024._RPP ! stencil 3 - c(0,4)= -21._RPP/1024._RPP; c(1,4)= 189._RPP/512._RPP ; c(2,4)= 945._RPP/1024._RPP ! stencil 4 - c(0,5)= 231._RPP/1024._RPP; c(1,5)= 693._RPP/512._RPP ; c(2,5)=-1155._RPP/1024._RPP ! stencil 5 - c(0,6)= 3003._RPP/1024._RPP; c(1,6)=-3003._RPP/512._RPP ; c(2,6)= 9009._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 231._RPP/256._RPP ; c(4,0)=-1155._RPP/1024._RPP; c(5,0)= 693._RPP/512._RPP ! stencil 0 - c(3,1)= -105._RPP/256._RPP ; c(4,1)= 945._RPP/1024._RPP; c(5,1)= 189._RPP/512._RPP ! stencil 1 - c(3,2)= 175._RPP/256._RPP ; c(4,2)= 525._RPP/1024._RPP; c(5,2)= -35._RPP/512._RPP ! stencil 2 - c(3,3)= 175._RPP/256._RPP ; c(4,3)= -175._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ! stencil 3 - c(3,4)= -105._RPP/256._RPP ; c(4,4)= 189._RPP/1024._RPP; c(5,4)= -27._RPP/512._RPP ! stencil 4 - c(3,5)= 231._RPP/256._RPP ; c(4,5)= -495._RPP/1024._RPP; c(5,5)= 77._RPP/512._RPP ! stencil 5 - c(3,6)=-2145._RPP/256._RPP ; c(4,6)= 5005._RPP/1024._RPP; c(5,6)= -819._RPP/512._RPP ! stencil 6 - ! cell 6 - c(6,0)= 231._RPP/1024._RPP ! stencil 0 - c(6,1)= -21._RPP/1024._RPP ! stencil 1 - c(6,2)= 7._RPP/1024._RPP ! stencil 2 - c(6,3)= -5._RPP/1024._RPP ! stencil 3 - c(6,4)= 7._RPP/1024._RPP ! stencil 4 - c(6,5)= -21._RPP/1024._RPP ! stencil 5 - c(6,6)= 231._RPP/1024._RPP ! stencil 6 - case(8) ! 15th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 33._RPP/2048._RPP; c(1,0)= -273._RPP/2048._RPP; c(2,0)= 1001._RPP/2048._RPP ! stencil 0 - c(0,1)= -9._RPP/2048._RPP; c(1,1)= 77._RPP/2048._RPP; c(2,1)= -297._RPP/2048._RPP ! stencil 1 - c(0,2)= 5._RPP/2048._RPP; c(1,2)= -45._RPP/2048._RPP; c(2,2)= 189._RPP/2048._RPP ! stencil 2 - c(0,3)= -5._RPP/2048._RPP; c(1,3)= 49._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 - c(0,4)= 9._RPP/2048._RPP; c(1,4)= -105._RPP/2048._RPP; c(2,4)= 945._RPP/2048._RPP ! stencil 4 - c(0,5)= -33._RPP/2048._RPP; c(1,5)= 693._RPP/2048._RPP; c(2,5)= 2079._RPP/2048._RPP ! stencil 5 - c(0,6)= 429._RPP/2048._RPP; c(1,6)= 3003._RPP/2048._RPP; c(2,6)= -3003._RPP/2048._RPP ! stencil 6 - c(0,7)= 6435._RPP/2048._RPP; c(1,7)=-15015._RPP/2048._RPP; c(2,7)= 27027._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= -2145._RPP/2048._RPP; c(4,0)= 3003._RPP/2048._RPP; c(5,0)= -3003._RPP/2048._RPP ! stencil 0 - c(3,1)= 693._RPP/2048._RPP; c(4,1)= -1155._RPP/2048._RPP; c(5,1)= 2079._RPP/2048._RPP ! stencil 1 - c(3,2)= -525._RPP/2048._RPP; c(4,2)= 1575._RPP/2048._RPP; c(5,2)= 945._RPP/2048._RPP ! stencil 2 - c(3,3)= 1225._RPP/2048._RPP; c(4,3)= 1225._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 - c(3,4)= 1575._RPP/2048._RPP; c(4,4)= -525._RPP/2048._RPP; c(5,4)= 189._RPP/2048._RPP ! stencil 4 - c(3,5)= -1155._RPP/2048._RPP; c(4,5)= 693._RPP/2048._RPP; c(5,5)= -297._RPP/2048._RPP ! stencil 5 - c(3,6)= 3003._RPP/2048._RPP; c(4,6)= -2145._RPP/2048._RPP; c(5,6)= 1001._RPP/2048._RPP ! stencil 6 - c(3,7)=-32175._RPP/2048._RPP; c(4,7)= 25025._RPP/2048._RPP; c(5,7)=-12285._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(6,0)= 3003._RPP/2048._RPP; c(7,0)= 429._RPP/2048._RPP ! stencil 0 - c(6,1)= 693._RPP/2048._RPP; c(7,1)= -33._RPP/2048._RPP ! stencil 1 - c(6,2)= -105._RPP/2048._RPP; c(7,2)= 9._RPP/2048._RPP ! stencil 2 - c(6,3)= 49._RPP/2048._RPP; c(7,3)= -5._RPP/2048._RPP ! stencil 3 - c(6,4)= -45._RPP/2048._RPP; c(7,4)= 5._RPP/2048._RPP ! stencil 4 - c(6,5)= 77._RPP/2048._RPP; c(7,5)= -9._RPP/2048._RPP ! stencil 5 - c(6,6)= -273._RPP/2048._RPP; c(7,6)= 33._RPP/2048._RPP ! stencil 6 - c(6,7)= 3465._RPP/2048._RPP; c(7,7)= -429._RPP/2048._RPP ! stencil 7 - case(9) ! 17th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -429._RPP/32768._RPP; c(1,0)= 495._RPP/4096._RPP ; c(2,0)= -4095._RPP/8192._RPP ! stencil 0 - c(0,1)= 99._RPP/32768._RPP; c(1,1)= -117._RPP/4096._RPP ; c(2,1)= 1001._RPP/8192._RPP ! stencil 1 - c(0,2)= -45._RPP/32768._RPP; c(1,2)= 55._RPP/4096._RPP ; c(2,2)= -495._RPP/8192._RPP ! stencil 2 - c(0,3)= 35._RPP/32768._RPP; c(1,3)= -45._RPP/4096._RPP ; c(2,3)= 441._RPP/8192._RPP ! stencil 3 - c(0,4)= -45._RPP/32768._RPP; c(1,4)= 63._RPP/4096._RPP ; c(2,4)= -735._RPP/8192._RPP ! stencil 4 - c(0,5)= 99._RPP/32768._RPP; c(1,5)= -165._RPP/4096._RPP ; c(2,5)= 3465._RPP/8192._RPP ! stencil 5 - c(0,6)= -429._RPP/32768._RPP; c(1,6)= 1287._RPP/4096._RPP ; c(2,6)= 9009._RPP/8192._RPP ! stencil 6 - c(0,7)= 6435._RPP/32768._RPP; c(1,7)= 6435._RPP/4096._RPP ; c(2,7)= -15015._RPP/8192._RPP ! stencil 7 - c(0,8)= 109395._RPP/32768._RPP; c(1,8)= -36465._RPP/4096._RPP ; c(2,8)= 153153._RPP/8192._RPP ! stencil 8 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(5,0)= 9009._RPP/4096._RPP ! stencil 0 - c(3,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(5,1)= -3003._RPP/4096._RPP ! stencil 1 - c(3,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(5,2)= 3465._RPP/4096._RPP ! stencil 2 - c(3,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(5,3)= 2205._RPP/4096._RPP ! stencil 3 - c(3,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= -735._RPP/4096._RPP ! stencil 4 - c(3,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(5,5)= 693._RPP/4096._RPP ! stencil 5 - c(3,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(5,6)= -1287._RPP/4096._RPP ! stencil 6 - c(3,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(5,7)= 5005._RPP/4096._RPP ! stencil 7 - c(3,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(5,8)= -69615._RPP/4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(6,0)= -15015._RPP/8192._RPP ; c(7,0)= 6435._RPP/4096._RPP ; c(8,0)= 6435._RPP/32768._RPP ! stencil 0 - c(6,1)= 9009._RPP/8192._RPP ; c(7,1)= 1287._RPP/4096._RPP ; c(8,1)= -429._RPP/32768._RPP ! stencil 1 - c(6,2)= 3465._RPP/8192._RPP ; c(7,2)= -165._RPP/4096._RPP ; c(8,2)= 99._RPP/32768._RPP ! stencil 2 - c(6,3)= -735._RPP/8192._RPP ; c(7,3)= 63._RPP/4096._RPP ; c(8,3)= -45._RPP/32768._RPP ! stencil 3 - c(6,4)= 441._RPP/8192._RPP ; c(7,4)= -45._RPP/4096._RPP ; c(8,4)= 35._RPP/32768._RPP ! stencil 4 - c(6,5)= -495._RPP/8192._RPP ; c(7,5)= 55._RPP/4096._RPP ; c(8,5)= -45._RPP/32768._RPP ! stencil 5 - c(6,6)= 1001._RPP/8192._RPP ; c(7,6)= -117._RPP/4096._RPP ; c(8,6)= 99._RPP/32768._RPP ! stencil 6 - c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 - c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 - endselect - elseif((x_target-(stencil(0)+stencil(1))/2._RPP)<10._RPP**(-10)) then - ! right interface (i+1/2) - select case(self%S) - case(2) ! 3rd order - ! cell 0 ; cell 1 - c(0,0)= -0.5_RPP; c(1,0)= 1.5_RPP ! stencil 0 - c(0,1)= 0.5_RPP; c(1,1)= 0.5_RPP ! stencil 1 - case(3) ! 5th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(2,0)= 15._RPP/8._RPP ! stencil 0 - c(0,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= 3._RPP/8._RPP ! stencil 1 - c(0,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(2,2)= -1._RPP/8._RPP ! stencil 2 - case(4) ! 7th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -5._RPP/16._RPP; c(1,0)= 21._RPP/16._RPP; c(2,0)=-35._RPP/16._RPP; c(3,0)= 35._RPP/16._RPP ! stencil 0 - c(0,1)= 1._RPP/16._RPP; c(1,1)= -5._RPP/16._RPP; c(2,1)= 15._RPP/16._RPP; c(3,1)= 5._RPP/16._RPP ! stencil 1 - c(0,2)= -1._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(3,2)= -1._RPP/16._RPP ! stencil 2 - c(0,3)= 5._RPP/16._RPP; c(1,3)= 15._RPP/16._RPP; c(2,3)= -5._RPP/16._RPP; c(3,3)= 1._RPP/16._RPP ! stencil 3 - case(5) ! 9th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 35._RPP/128._RPP; c(1,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(3,0)=-105._RPP/32._RPP ! stencil 0 - c(0,1)= -5._RPP/128._RPP; c(1,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(3,1)= 35._RPP/32._RPP ! stencil 1 - c(0,2)= 3._RPP/128._RPP; c(1,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= 15._RPP/32._RPP ! stencil 2 - c(0,3)= -5._RPP/128._RPP; c(1,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(3,3)= -5._RPP/32._RPP ! stencil 3 - c(0,4)= 35._RPP/128._RPP; c(1,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(3,4)= 7._RPP/32._RPP ! stencil 4 - ! cell 4 - c(4,0)= 315._RPP/128._RPP ! stencil 0 - c(4,1)= 35._RPP/128._RPP ! stencil 1 - c(4,2)= -5._RPP/128._RPP ! stencil 2 - c(4,3)= 3._RPP/128._RPP ! stencil 3 - c(4,4)= -5._RPP/128._RPP ! stencil 4 - case(6) ! 11th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP ! stencil 0 - c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP ! stencil 1 - c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP ! stencil 2 - c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP ! stencil 3 - c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP ! stencil 4 - c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP ! stencil 5 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 693._RPP/128._RPP; c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 - c(3,1)= -105._RPP/128._RPP; c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 - c(3,2)= 105._RPP/128._RPP; c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 - c(3,3)= 75._RPP/128._RPP; c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 - c(3,4)= -35._RPP/128._RPP; c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 - c(3,5)= 63._RPP/128._RPP; c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 - case(7) ! 13th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 - c(0,1)= -21._RPP/1024._RPP; c(1,1)= 77._RPP/512._RPP ; c(2,1)= -495._RPP/1024._RPP ! stencil 1 - c(0,2)= 7._RPP/1024._RPP; c(1,2)= -27._RPP/512._RPP ; c(2,2)= 189._RPP/1024._RPP ! stencil 2 - c(0,3)= -5._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ; c(2,3)= -175._RPP/1024._RPP ! stencil 3 - c(0,4)= 7._RPP/1024._RPP; c(1,4)= -35._RPP/512._RPP ; c(2,4)= 525._RPP/1024._RPP ! stencil 4 - c(0,5)= -21._RPP/1024._RPP; c(1,5)= 189._RPP/512._RPP ; c(2,5)= 945._RPP/1024._RPP ! stencil 5 - c(0,6)= 231._RPP/1024._RPP; c(1,6)= 693._RPP/512._RPP ; c(2,6)=-1155._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)=-2145._RPP/256._RPP ; c(4,0)= 9009._RPP/1024._RPP; c(5,0)=-3003._RPP/512._RPP ! stencil 0 - c(3,1)= 231._RPP/256._RPP ; c(4,1)=-1155._RPP/1024._RPP; c(5,1)= 693._RPP/512._RPP ! stencil 1 - c(3,2)= -105._RPP/256._RPP ; c(4,2)= 945._RPP/1024._RPP; c(5,2)= 189._RPP/512._RPP ! stencil 2 - c(3,3)= 175._RPP/256._RPP ; c(4,3)= 525._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ! stencil 3 - c(3,4)= 175._RPP/256._RPP ; c(4,4)= -175._RPP/1024._RPP; c(5,4)= 21._RPP/512._RPP ! stencil 4 - c(3,5)= -105._RPP/256._RPP ; c(4,5)= 189._RPP/1024._RPP; c(5,5)= -27._RPP/512._RPP ! stencil 5 - c(3,6)= 231._RPP/256._RPP ; c(4,6)= -495._RPP/1024._RPP; c(5,6)= 77._RPP/512._RPP ! stencil 6 - ! cell 6 - c(6,0)= 3003._RPP/1024._RPP ! stencil 0 - c(6,1)= 231._RPP/1024._RPP ! stencil 1 - c(6,2)= -21._RPP/1024._RPP ! stencil 2 - c(6,3)= 7._RPP/1024._RPP ! stencil 3 - c(6,4)= -5._RPP/1024._RPP ! stencil 4 - c(6,5)= 7._RPP/1024._RPP ! stencil 5 - c(6,6)= -21._RPP/1024._RPP ! stencil 6 - case(8) ! 15th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -429._RPP/2048._RPP; c(1,0)= 3465._RPP/2048._RPP; c(2,0)=-12285._RPP/2048._RPP ! stencil 0 - c(0,1)= 33._RPP/2048._RPP; c(1,1)= -273._RPP/2048._RPP; c(2,1)= 1001._RPP/2048._RPP ! stencil 1 - c(0,2)= -9._RPP/2048._RPP; c(1,2)= 77._RPP/2048._RPP; c(2,2)= -297._RPP/2048._RPP ! stencil 2 - c(0,3)= 5._RPP/2048._RPP; c(1,3)= -45._RPP/2048._RPP; c(2,3)= 189._RPP/2048._RPP ! stencil 3 - c(0,4)= -5._RPP/2048._RPP; c(1,4)= 49._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 - c(0,5)= 9._RPP/2048._RPP; c(1,5)= -105._RPP/2048._RPP; c(2,5)= 945._RPP/2048._RPP ! stencil 5 - c(0,6)= -33._RPP/2048._RPP; c(1,6)= 693._RPP/2048._RPP; c(2,6)= 2079._RPP/2048._RPP ! stencil 6 - c(0,7)= 429._RPP/2048._RPP; c(1,7)= 3003._RPP/2048._RPP; c(2,7)= -3003._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 25025._RPP/2048._RPP; c(4,0)=-32175._RPP/2048._RPP; c(5,0)= 27027._RPP/2048._RPP ! stencil 0 - c(3,1)= -2145._RPP/2048._RPP; c(4,1)= 3003._RPP/2048._RPP; c(5,1)= -3003._RPP/2048._RPP ! stencil 1 - c(3,2)= 693._RPP/2048._RPP; c(4,2)= -1155._RPP/2048._RPP; c(5,2)= 2079._RPP/2048._RPP ! stencil 2 - c(3,3)= -525._RPP/2048._RPP; c(4,3)= 1575._RPP/2048._RPP; c(5,3)= 945._RPP/2048._RPP ! stencil 3 - c(3,4)= 1225._RPP/2048._RPP; c(4,4)= 1225._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 - c(3,5)= 1575._RPP/2048._RPP; c(4,5)= -525._RPP/2048._RPP; c(5,5)= 189._RPP/2048._RPP ! stencil 5 - c(3,6)= -1155._RPP/2048._RPP; c(4,6)= 693._RPP/2048._RPP; c(5,6)= -297._RPP/2048._RPP ! stencil 6 - c(3,7)= 3003._RPP/2048._RPP; c(4,7)= -2145._RPP/2048._RPP; c(5,7)= 1001._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(6,0)=-15015._RPP/2048._RPP; c(7,0)= 6435._RPP/2048._RPP ! stencil 0 - c(6,1)= 3003._RPP/2048._RPP; c(7,1)= 429._RPP/2048._RPP ! stencil 1 - c(6,2)= 693._RPP/2048._RPP; c(7,2)= -33._RPP/2048._RPP ! stencil 2 - c(6,3)= -105._RPP/2048._RPP; c(7,3)= 9._RPP/2048._RPP ! stencil 3 - c(6,4)= 49._RPP/2048._RPP; c(7,4)= -5._RPP/2048._RPP ! stencil 4 - c(6,5)= -45._RPP/2048._RPP; c(7,5)= 5._RPP/2048._RPP ! stencil 5 - c(6,6)= 77._RPP/2048._RPP; c(7,6)= -9._RPP/2048._RPP ! stencil 6 - c(6,7)= -273._RPP/2048._RPP; c(7,7)= 33._RPP/2048._RPP ! stencil 7 - case(9) ! 17th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 6435._RPP/32768._RPP; c(1,0)= -7293._RPP/ 4096._RPP; c(2,0)= 58905._RPP/ 8192._RPP ! stencil 0 - c(0,1)= -429._RPP/32768._RPP; c(1,1)= 495._RPP/ 4096._RPP; c(2,1)= -4095._RPP/ 8192._RPP ! stencil 1 - c(0,2)= 99._RPP/32768._RPP; c(1,2)= -117._RPP/ 4096._RPP; c(2,2)= 1001._RPP/ 8192._RPP ! stencil 2 - c(0,3)= -45._RPP/32768._RPP; c(1,3)= 55._RPP/ 4096._RPP; c(2,3)= -495._RPP/ 8192._RPP ! stencil 3 - c(0,4)= 35._RPP/32768._RPP; c(1,4)= -45._RPP/ 4096._RPP; c(2,4)= 441._RPP/ 8192._RPP ! stencil 4 - c(0,5)= -45._RPP/32768._RPP; c(1,5)= 63._RPP/ 4096._RPP; c(2,5)= -735._RPP/ 8192._RPP ! stencil 5 - c(0,6)= 99._RPP/32768._RPP; c(1,6)= -165._RPP/ 4096._RPP; c(2,6)= 3465._RPP/ 8192._RPP ! stencil 6 - c(0,7)= -429._RPP/32768._RPP; c(1,7)= 1287._RPP/ 4096._RPP; c(2,7)= 9009._RPP/ 8192._RPP ! stencil 7 - c(0,8)= 6435._RPP/32768._RPP; c(1,8)= 6435._RPP/ 4096._RPP; c(2,8)= -15015._RPP/ 8192._RPP ! stencil 8 - ! cell 3 ; ! cell 4 ; cell 5 - c(3,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(5,0)=-109395._RPP/ 4096._RPP ! stencil 0 - c(3,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(5,1)= 9009._RPP/ 4096._RPP ! stencil 1 - c(3,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(5,2)= -3003._RPP/ 4096._RPP ! stencil 2 - c(3,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(5,3)= 3465._RPP/ 4096._RPP ! stencil 3 - c(3,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= 2205._RPP/ 4096._RPP ! stencil 4 - c(3,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(5,5)= -735._RPP/ 4096._RPP ! stencil 5 - c(3,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(5,6)= 693._RPP/ 4096._RPP ! stencil 6 - c(3,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(5,7)= -1287._RPP/ 4096._RPP ! stencil 7 - c(3,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(5,8)= 5005._RPP/ 4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(6,0)= 153153._RPP/ 8192._RPP; c(7,0)= -36465._RPP/ 4096._RPP; c(8,0)= 109395._RPP/32768._RPP ! stencil 0 - c(6,1)= -15015._RPP/ 8192._RPP; c(7,1)= 6435._RPP/ 4096._RPP; c(8,1)= 6435._RPP/32768._RPP ! stencil 1 - c(6,2)= 9009._RPP/ 8192._RPP; c(7,2)= 1287._RPP/ 4096._RPP; c(8,2)= -429._RPP/32768._RPP ! stencil 2 - c(6,3)= 3465._RPP/ 8192._RPP; c(7,3)= -165._RPP/ 4096._RPP; c(8,3)= 99._RPP/32768._RPP ! stencil 3 - c(6,4)= -735._RPP/ 8192._RPP; c(7,4)= 63._RPP/ 4096._RPP; c(8,4)= -45._RPP/32768._RPP ! stencil 4 - c(6,5)= 441._RPP/ 8192._RPP; c(7,5)= -45._RPP/ 4096._RPP; c(8,5)= 35._RPP/32768._RPP ! stencil 5 - c(6,6)= -495._RPP/ 8192._RPP; c(7,6)= 55._RPP/ 4096._RPP; c(8,6)= -45._RPP/32768._RPP ! stencil 6 - c(6,7)= 1001._RPP/ 8192._RPP; c(7,7)= -117._RPP/ 4096._RPP; c(8,7)= 99._RPP/32768._RPP ! stencil 7 - c(6,8)= -4095._RPP/ 8192._RPP; c(7,8)= 495._RPP/ 4096._RPP; c(8,8)= -429._RPP/32768._RPP ! stencil 8 - endselect - else - ! internal point - do k=0,S-1 !stencils loop - do j=0,S-1 !values loop - prod = 1._RPP - do i=0,S-1 - if (i==j) cycle - prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j+1) - stencil(-S+k+i+1))) + select type(constructor) + type is(interpolations_int_js_constructor) + associate(S => self%S, c => self%coef, stencil => constructor%stencil, x_target => constructor%x_target) + if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then + ! left interface (i-1/2) + select case(S) + case(2) ! 3rd order + ! cell 0 ; cell 1 + c(0,0)= 0.5_RPP; c(1,0)= 0.5_RPP ! stencil 0 + c(0,1)= 1.5_RPP; c(1,1)= -0.5_RPP ! stencil 1 + case(3) ! 5th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(2,0)= 3._RPP/8._RPP ! stencil 0 + c(0,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= -1._RPP/8._RPP ! stencil 1 + c(0,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(2,2)= 3._RPP/8._RPP ! stencil 2 + case(4) ! 7th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 1._RPP/16._RPP; c(1,0)= -5._RPP/16._RPP; c(2,0)= 15._RPP/16._RPP; c(3,0)= 5._RPP/16._RPP ! stencil 0 + c(0,1)= -1._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(3,1)= -1._RPP/16._RPP ! stencil 1 + c(0,2)= 5._RPP/16._RPP; c(1,2)= 15._RPP/16._RPP; c(2,2)= -5._RPP/16._RPP; c(3,2)= 1._RPP/16._RPP ! stencil 2 + c(0,3)= 35._RPP/16._RPP; c(1,3)=-35._RPP/16._RPP; c(2,3)= 21._RPP/16._RPP; c(3,3)= -5._RPP/16._RPP ! stencil 3 + case(5) ! 9th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -5._RPP/128._RPP; c(1,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(3,0)= 35._RPP/32._RPP ! stencil 0 + c(0,1)= 3._RPP/128._RPP; c(1,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(3,1)= 15._RPP/32._RPP ! stencil 1 + c(0,2)= -5._RPP/128._RPP; c(1,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= -5._RPP/32._RPP ! stencil 2 + c(0,3)= 35._RPP/128._RPP; c(1,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(3,3)= 7._RPP/32._RPP ! stencil 3 + c(0,4)= 315._RPP/128._RPP; c(1,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(3,4)= -45._RPP/32._RPP ! stencil 4 + ! cell 4 + c(4,0)= 35._RPP/128._RPP ! stencil 0 + c(4,1)= -5._RPP/128._RPP ! stencil 1 + c(4,2)= 3._RPP/128._RPP ! stencil 2 + c(4,3)= -5._RPP/128._RPP ! stencil 3 + c(4,4)= 35._RPP/128._RPP ! stencil 4 + case(6) ! 11th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP ! stencil 0 + c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP ! stencil 1 + c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP ! stencil 2 + c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP ! stencil 3 + c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP ! stencil 4 + c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP ! stencil 5 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= -105._RPP/128._RPP; c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 + c(3,1)= 105._RPP/128._RPP; c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 + c(3,2)= 75._RPP/128._RPP; c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 + c(3,3)= -35._RPP/128._RPP; c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 + c(3,4)= 63._RPP/128._RPP; c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 + c(3,5)= -495._RPP/128._RPP; c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 + case(7) ! 13th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 + c(0,1)= 7._RPP/1024._RPP; c(1,1)= -27._RPP/512._RPP ; c(2,1)= 189._RPP/1024._RPP ! stencil 1 + c(0,2)= -5._RPP/1024._RPP; c(1,2)= 21._RPP/512._RPP ; c(2,2)= -175._RPP/1024._RPP ! stencil 2 + c(0,3)= 7._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ; c(2,3)= 525._RPP/1024._RPP ! stencil 3 + c(0,4)= -21._RPP/1024._RPP; c(1,4)= 189._RPP/512._RPP ; c(2,4)= 945._RPP/1024._RPP ! stencil 4 + c(0,5)= 231._RPP/1024._RPP; c(1,5)= 693._RPP/512._RPP ; c(2,5)=-1155._RPP/1024._RPP ! stencil 5 + c(0,6)= 3003._RPP/1024._RPP; c(1,6)=-3003._RPP/512._RPP ; c(2,6)= 9009._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 231._RPP/256._RPP ; c(4,0)=-1155._RPP/1024._RPP; c(5,0)= 693._RPP/512._RPP ! stencil 0 + c(3,1)= -105._RPP/256._RPP ; c(4,1)= 945._RPP/1024._RPP; c(5,1)= 189._RPP/512._RPP ! stencil 1 + c(3,2)= 175._RPP/256._RPP ; c(4,2)= 525._RPP/1024._RPP; c(5,2)= -35._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(4,3)= -175._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ! stencil 3 + c(3,4)= -105._RPP/256._RPP ; c(4,4)= 189._RPP/1024._RPP; c(5,4)= -27._RPP/512._RPP ! stencil 4 + c(3,5)= 231._RPP/256._RPP ; c(4,5)= -495._RPP/1024._RPP; c(5,5)= 77._RPP/512._RPP ! stencil 5 + c(3,6)=-2145._RPP/256._RPP ; c(4,6)= 5005._RPP/1024._RPP; c(5,6)= -819._RPP/512._RPP ! stencil 6 + ! cell 6 + c(6,0)= 231._RPP/1024._RPP ! stencil 0 + c(6,1)= -21._RPP/1024._RPP ! stencil 1 + c(6,2)= 7._RPP/1024._RPP ! stencil 2 + c(6,3)= -5._RPP/1024._RPP ! stencil 3 + c(6,4)= 7._RPP/1024._RPP ! stencil 4 + c(6,5)= -21._RPP/1024._RPP ! stencil 5 + c(6,6)= 231._RPP/1024._RPP ! stencil 6 + case(8) ! 15th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 33._RPP/2048._RPP; c(1,0)= -273._RPP/2048._RPP; c(2,0)= 1001._RPP/2048._RPP ! stencil 0 + c(0,1)= -9._RPP/2048._RPP; c(1,1)= 77._RPP/2048._RPP; c(2,1)= -297._RPP/2048._RPP ! stencil 1 + c(0,2)= 5._RPP/2048._RPP; c(1,2)= -45._RPP/2048._RPP; c(2,2)= 189._RPP/2048._RPP ! stencil 2 + c(0,3)= -5._RPP/2048._RPP; c(1,3)= 49._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 + c(0,4)= 9._RPP/2048._RPP; c(1,4)= -105._RPP/2048._RPP; c(2,4)= 945._RPP/2048._RPP ! stencil 4 + c(0,5)= -33._RPP/2048._RPP; c(1,5)= 693._RPP/2048._RPP; c(2,5)= 2079._RPP/2048._RPP ! stencil 5 + c(0,6)= 429._RPP/2048._RPP; c(1,6)= 3003._RPP/2048._RPP; c(2,6)= -3003._RPP/2048._RPP ! stencil 6 + c(0,7)= 6435._RPP/2048._RPP; c(1,7)=-15015._RPP/2048._RPP; c(2,7)= 27027._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= -2145._RPP/2048._RPP; c(4,0)= 3003._RPP/2048._RPP; c(5,0)= -3003._RPP/2048._RPP ! stencil 0 + c(3,1)= 693._RPP/2048._RPP; c(4,1)= -1155._RPP/2048._RPP; c(5,1)= 2079._RPP/2048._RPP ! stencil 1 + c(3,2)= -525._RPP/2048._RPP; c(4,2)= 1575._RPP/2048._RPP; c(5,2)= 945._RPP/2048._RPP ! stencil 2 + c(3,3)= 1225._RPP/2048._RPP; c(4,3)= 1225._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 + c(3,4)= 1575._RPP/2048._RPP; c(4,4)= -525._RPP/2048._RPP; c(5,4)= 189._RPP/2048._RPP ! stencil 4 + c(3,5)= -1155._RPP/2048._RPP; c(4,5)= 693._RPP/2048._RPP; c(5,5)= -297._RPP/2048._RPP ! stencil 5 + c(3,6)= 3003._RPP/2048._RPP; c(4,6)= -2145._RPP/2048._RPP; c(5,6)= 1001._RPP/2048._RPP ! stencil 6 + c(3,7)=-32175._RPP/2048._RPP; c(4,7)= 25025._RPP/2048._RPP; c(5,7)=-12285._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(6,0)= 3003._RPP/2048._RPP; c(7,0)= 429._RPP/2048._RPP ! stencil 0 + c(6,1)= 693._RPP/2048._RPP; c(7,1)= -33._RPP/2048._RPP ! stencil 1 + c(6,2)= -105._RPP/2048._RPP; c(7,2)= 9._RPP/2048._RPP ! stencil 2 + c(6,3)= 49._RPP/2048._RPP; c(7,3)= -5._RPP/2048._RPP ! stencil 3 + c(6,4)= -45._RPP/2048._RPP; c(7,4)= 5._RPP/2048._RPP ! stencil 4 + c(6,5)= 77._RPP/2048._RPP; c(7,5)= -9._RPP/2048._RPP ! stencil 5 + c(6,6)= -273._RPP/2048._RPP; c(7,6)= 33._RPP/2048._RPP ! stencil 6 + c(6,7)= 3465._RPP/2048._RPP; c(7,7)= -429._RPP/2048._RPP ! stencil 7 + case(9) ! 17th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -429._RPP/32768._RPP; c(1,0)= 495._RPP/4096._RPP ; c(2,0)= -4095._RPP/8192._RPP ! stencil 0 + c(0,1)= 99._RPP/32768._RPP; c(1,1)= -117._RPP/4096._RPP ; c(2,1)= 1001._RPP/8192._RPP ! stencil 1 + c(0,2)= -45._RPP/32768._RPP; c(1,2)= 55._RPP/4096._RPP ; c(2,2)= -495._RPP/8192._RPP ! stencil 2 + c(0,3)= 35._RPP/32768._RPP; c(1,3)= -45._RPP/4096._RPP ; c(2,3)= 441._RPP/8192._RPP ! stencil 3 + c(0,4)= -45._RPP/32768._RPP; c(1,4)= 63._RPP/4096._RPP ; c(2,4)= -735._RPP/8192._RPP ! stencil 4 + c(0,5)= 99._RPP/32768._RPP; c(1,5)= -165._RPP/4096._RPP ; c(2,5)= 3465._RPP/8192._RPP ! stencil 5 + c(0,6)= -429._RPP/32768._RPP; c(1,6)= 1287._RPP/4096._RPP ; c(2,6)= 9009._RPP/8192._RPP ! stencil 6 + c(0,7)= 6435._RPP/32768._RPP; c(1,7)= 6435._RPP/4096._RPP ; c(2,7)= -15015._RPP/8192._RPP ! stencil 7 + c(0,8)= 109395._RPP/32768._RPP; c(1,8)= -36465._RPP/4096._RPP ; c(2,8)= 153153._RPP/8192._RPP ! stencil 8 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(5,0)= 9009._RPP/4096._RPP ! stencil 0 + c(3,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(5,1)= -3003._RPP/4096._RPP ! stencil 1 + c(3,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(5,2)= 3465._RPP/4096._RPP ! stencil 2 + c(3,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(5,3)= 2205._RPP/4096._RPP ! stencil 3 + c(3,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= -735._RPP/4096._RPP ! stencil 4 + c(3,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(5,5)= 693._RPP/4096._RPP ! stencil 5 + c(3,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(5,6)= -1287._RPP/4096._RPP ! stencil 6 + c(3,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(5,7)= 5005._RPP/4096._RPP ! stencil 7 + c(3,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(5,8)= -69615._RPP/4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(6,0)= -15015._RPP/8192._RPP ; c(7,0)= 6435._RPP/4096._RPP ; c(8,0)= 6435._RPP/32768._RPP ! stencil 0 + c(6,1)= 9009._RPP/8192._RPP ; c(7,1)= 1287._RPP/4096._RPP ; c(8,1)= -429._RPP/32768._RPP ! stencil 1 + c(6,2)= 3465._RPP/8192._RPP ; c(7,2)= -165._RPP/4096._RPP ; c(8,2)= 99._RPP/32768._RPP ! stencil 2 + c(6,3)= -735._RPP/8192._RPP ; c(7,3)= 63._RPP/4096._RPP ; c(8,3)= -45._RPP/32768._RPP ! stencil 3 + c(6,4)= 441._RPP/8192._RPP ; c(7,4)= -45._RPP/4096._RPP ; c(8,4)= 35._RPP/32768._RPP ! stencil 4 + c(6,5)= -495._RPP/8192._RPP ; c(7,5)= 55._RPP/4096._RPP ; c(8,5)= -45._RPP/32768._RPP ! stencil 5 + c(6,6)= 1001._RPP/8192._RPP ; c(7,6)= -117._RPP/4096._RPP ; c(8,6)= 99._RPP/32768._RPP ! stencil 6 + c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 + c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 + endselect + elseif((x_target-(stencil(0)+stencil(1))/2._RPP)<10._RPP**(-10)) then + ! right interface (i+1/2) + select case(self%S) + case(2) ! 3rd order + ! cell 0 ; cell 1 + c(0,0)= -0.5_RPP; c(1,0)= 1.5_RPP ! stencil 0 + c(0,1)= 0.5_RPP; c(1,1)= 0.5_RPP ! stencil 1 + case(3) ! 5th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(2,0)= 15._RPP/8._RPP ! stencil 0 + c(0,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= 3._RPP/8._RPP ! stencil 1 + c(0,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(2,2)= -1._RPP/8._RPP ! stencil 2 + case(4) ! 7th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= -5._RPP/16._RPP; c(1,0)= 21._RPP/16._RPP; c(2,0)=-35._RPP/16._RPP; c(3,0)= 35._RPP/16._RPP ! stencil 0 + c(0,1)= 1._RPP/16._RPP; c(1,1)= -5._RPP/16._RPP; c(2,1)= 15._RPP/16._RPP; c(3,1)= 5._RPP/16._RPP ! stencil 1 + c(0,2)= -1._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(3,2)= -1._RPP/16._RPP ! stencil 2 + c(0,3)= 5._RPP/16._RPP; c(1,3)= 15._RPP/16._RPP; c(2,3)= -5._RPP/16._RPP; c(3,3)= 1._RPP/16._RPP ! stencil 3 + case(5) ! 9th order + ! cell 0 ; cell 1 ; cell 2 ; cell 3 + c(0,0)= 35._RPP/128._RPP; c(1,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(3,0)=-105._RPP/32._RPP ! stencil 0 + c(0,1)= -5._RPP/128._RPP; c(1,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(3,1)= 35._RPP/32._RPP ! stencil 1 + c(0,2)= 3._RPP/128._RPP; c(1,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= 15._RPP/32._RPP ! stencil 2 + c(0,3)= -5._RPP/128._RPP; c(1,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(3,3)= -5._RPP/32._RPP ! stencil 3 + c(0,4)= 35._RPP/128._RPP; c(1,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(3,4)= 7._RPP/32._RPP ! stencil 4 + ! cell 4 + c(4,0)= 315._RPP/128._RPP ! stencil 0 + c(4,1)= 35._RPP/128._RPP ! stencil 1 + c(4,2)= -5._RPP/128._RPP ! stencil 2 + c(4,3)= 3._RPP/128._RPP ! stencil 3 + c(4,4)= -5._RPP/128._RPP ! stencil 4 + case(6) ! 11th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP ! stencil 0 + c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP ! stencil 1 + c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP ! stencil 2 + c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP ! stencil 3 + c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP ! stencil 4 + c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP ! stencil 5 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 693._RPP/128._RPP; c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 + c(3,1)= -105._RPP/128._RPP; c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 + c(3,2)= 105._RPP/128._RPP; c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 + c(3,3)= 75._RPP/128._RPP; c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 + c(3,4)= -35._RPP/128._RPP; c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 + c(3,5)= 63._RPP/128._RPP; c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 + case(7) ! 13th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 + c(0,1)= -21._RPP/1024._RPP; c(1,1)= 77._RPP/512._RPP ; c(2,1)= -495._RPP/1024._RPP ! stencil 1 + c(0,2)= 7._RPP/1024._RPP; c(1,2)= -27._RPP/512._RPP ; c(2,2)= 189._RPP/1024._RPP ! stencil 2 + c(0,3)= -5._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ; c(2,3)= -175._RPP/1024._RPP ! stencil 3 + c(0,4)= 7._RPP/1024._RPP; c(1,4)= -35._RPP/512._RPP ; c(2,4)= 525._RPP/1024._RPP ! stencil 4 + c(0,5)= -21._RPP/1024._RPP; c(1,5)= 189._RPP/512._RPP ; c(2,5)= 945._RPP/1024._RPP ! stencil 5 + c(0,6)= 231._RPP/1024._RPP; c(1,6)= 693._RPP/512._RPP ; c(2,6)=-1155._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)=-2145._RPP/256._RPP ; c(4,0)= 9009._RPP/1024._RPP; c(5,0)=-3003._RPP/512._RPP ! stencil 0 + c(3,1)= 231._RPP/256._RPP ; c(4,1)=-1155._RPP/1024._RPP; c(5,1)= 693._RPP/512._RPP ! stencil 1 + c(3,2)= -105._RPP/256._RPP ; c(4,2)= 945._RPP/1024._RPP; c(5,2)= 189._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(4,3)= 525._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ! stencil 3 + c(3,4)= 175._RPP/256._RPP ; c(4,4)= -175._RPP/1024._RPP; c(5,4)= 21._RPP/512._RPP ! stencil 4 + c(3,5)= -105._RPP/256._RPP ; c(4,5)= 189._RPP/1024._RPP; c(5,5)= -27._RPP/512._RPP ! stencil 5 + c(3,6)= 231._RPP/256._RPP ; c(4,6)= -495._RPP/1024._RPP; c(5,6)= 77._RPP/512._RPP ! stencil 6 + ! cell 6 + c(6,0)= 3003._RPP/1024._RPP ! stencil 0 + c(6,1)= 231._RPP/1024._RPP ! stencil 1 + c(6,2)= -21._RPP/1024._RPP ! stencil 2 + c(6,3)= 7._RPP/1024._RPP ! stencil 3 + c(6,4)= -5._RPP/1024._RPP ! stencil 4 + c(6,5)= 7._RPP/1024._RPP ! stencil 5 + c(6,6)= -21._RPP/1024._RPP ! stencil 6 + case(8) ! 15th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= -429._RPP/2048._RPP; c(1,0)= 3465._RPP/2048._RPP; c(2,0)=-12285._RPP/2048._RPP ! stencil 0 + c(0,1)= 33._RPP/2048._RPP; c(1,1)= -273._RPP/2048._RPP; c(2,1)= 1001._RPP/2048._RPP ! stencil 1 + c(0,2)= -9._RPP/2048._RPP; c(1,2)= 77._RPP/2048._RPP; c(2,2)= -297._RPP/2048._RPP ! stencil 2 + c(0,3)= 5._RPP/2048._RPP; c(1,3)= -45._RPP/2048._RPP; c(2,3)= 189._RPP/2048._RPP ! stencil 3 + c(0,4)= -5._RPP/2048._RPP; c(1,4)= 49._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 + c(0,5)= 9._RPP/2048._RPP; c(1,5)= -105._RPP/2048._RPP; c(2,5)= 945._RPP/2048._RPP ! stencil 5 + c(0,6)= -33._RPP/2048._RPP; c(1,6)= 693._RPP/2048._RPP; c(2,6)= 2079._RPP/2048._RPP ! stencil 6 + c(0,7)= 429._RPP/2048._RPP; c(1,7)= 3003._RPP/2048._RPP; c(2,7)= -3003._RPP/2048._RPP ! stencil 7 + ! cell 3 ; cell 4 ; cell 5 + c(3,0)= 25025._RPP/2048._RPP; c(4,0)=-32175._RPP/2048._RPP; c(5,0)= 27027._RPP/2048._RPP ! stencil 0 + c(3,1)= -2145._RPP/2048._RPP; c(4,1)= 3003._RPP/2048._RPP; c(5,1)= -3003._RPP/2048._RPP ! stencil 1 + c(3,2)= 693._RPP/2048._RPP; c(4,2)= -1155._RPP/2048._RPP; c(5,2)= 2079._RPP/2048._RPP ! stencil 2 + c(3,3)= -525._RPP/2048._RPP; c(4,3)= 1575._RPP/2048._RPP; c(5,3)= 945._RPP/2048._RPP ! stencil 3 + c(3,4)= 1225._RPP/2048._RPP; c(4,4)= 1225._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 + c(3,5)= 1575._RPP/2048._RPP; c(4,5)= -525._RPP/2048._RPP; c(5,5)= 189._RPP/2048._RPP ! stencil 5 + c(3,6)= -1155._RPP/2048._RPP; c(4,6)= 693._RPP/2048._RPP; c(5,6)= -297._RPP/2048._RPP ! stencil 6 + c(3,7)= 3003._RPP/2048._RPP; c(4,7)= -2145._RPP/2048._RPP; c(5,7)= 1001._RPP/2048._RPP ! stencil 7 + ! cell 6 ; cell 7 + c(6,0)=-15015._RPP/2048._RPP; c(7,0)= 6435._RPP/2048._RPP ! stencil 0 + c(6,1)= 3003._RPP/2048._RPP; c(7,1)= 429._RPP/2048._RPP ! stencil 1 + c(6,2)= 693._RPP/2048._RPP; c(7,2)= -33._RPP/2048._RPP ! stencil 2 + c(6,3)= -105._RPP/2048._RPP; c(7,3)= 9._RPP/2048._RPP ! stencil 3 + c(6,4)= 49._RPP/2048._RPP; c(7,4)= -5._RPP/2048._RPP ! stencil 4 + c(6,5)= -45._RPP/2048._RPP; c(7,5)= 5._RPP/2048._RPP ! stencil 5 + c(6,6)= 77._RPP/2048._RPP; c(7,6)= -9._RPP/2048._RPP ! stencil 6 + c(6,7)= -273._RPP/2048._RPP; c(7,7)= 33._RPP/2048._RPP ! stencil 7 + case(9) ! 17th order + ! cell 0 ; cell 1 ; cell 2 + c(0,0)= 6435._RPP/32768._RPP; c(1,0)= -7293._RPP/ 4096._RPP; c(2,0)= 58905._RPP/ 8192._RPP ! stencil 0 + c(0,1)= -429._RPP/32768._RPP; c(1,1)= 495._RPP/ 4096._RPP; c(2,1)= -4095._RPP/ 8192._RPP ! stencil 1 + c(0,2)= 99._RPP/32768._RPP; c(1,2)= -117._RPP/ 4096._RPP; c(2,2)= 1001._RPP/ 8192._RPP ! stencil 2 + c(0,3)= -45._RPP/32768._RPP; c(1,3)= 55._RPP/ 4096._RPP; c(2,3)= -495._RPP/ 8192._RPP ! stencil 3 + c(0,4)= 35._RPP/32768._RPP; c(1,4)= -45._RPP/ 4096._RPP; c(2,4)= 441._RPP/ 8192._RPP ! stencil 4 + c(0,5)= -45._RPP/32768._RPP; c(1,5)= 63._RPP/ 4096._RPP; c(2,5)= -735._RPP/ 8192._RPP ! stencil 5 + c(0,6)= 99._RPP/32768._RPP; c(1,6)= -165._RPP/ 4096._RPP; c(2,6)= 3465._RPP/ 8192._RPP ! stencil 6 + c(0,7)= -429._RPP/32768._RPP; c(1,7)= 1287._RPP/ 4096._RPP; c(2,7)= 9009._RPP/ 8192._RPP ! stencil 7 + c(0,8)= 6435._RPP/32768._RPP; c(1,8)= 6435._RPP/ 4096._RPP; c(2,8)= -15015._RPP/ 8192._RPP ! stencil 8 + ! cell 3 ; ! cell 4 ; cell 5 + c(3,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(5,0)=-109395._RPP/ 4096._RPP ! stencil 0 + c(3,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(5,1)= 9009._RPP/ 4096._RPP ! stencil 1 + c(3,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(5,2)= -3003._RPP/ 4096._RPP ! stencil 2 + c(3,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(5,3)= 3465._RPP/ 4096._RPP ! stencil 3 + c(3,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= 2205._RPP/ 4096._RPP ! stencil 4 + c(3,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(5,5)= -735._RPP/ 4096._RPP ! stencil 5 + c(3,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(5,6)= 693._RPP/ 4096._RPP ! stencil 6 + c(3,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(5,7)= -1287._RPP/ 4096._RPP ! stencil 7 + c(3,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(5,8)= 5005._RPP/ 4096._RPP ! stencil 8 + ! cell 6 ; cell 7 ; cell 8 + c(6,0)= 153153._RPP/ 8192._RPP; c(7,0)= -36465._RPP/ 4096._RPP; c(8,0)= 109395._RPP/32768._RPP ! stencil 0 + c(6,1)= -15015._RPP/ 8192._RPP; c(7,1)= 6435._RPP/ 4096._RPP; c(8,1)= 6435._RPP/32768._RPP ! stencil 1 + c(6,2)= 9009._RPP/ 8192._RPP; c(7,2)= 1287._RPP/ 4096._RPP; c(8,2)= -429._RPP/32768._RPP ! stencil 2 + c(6,3)= 3465._RPP/ 8192._RPP; c(7,3)= -165._RPP/ 4096._RPP; c(8,3)= 99._RPP/32768._RPP ! stencil 3 + c(6,4)= -735._RPP/ 8192._RPP; c(7,4)= 63._RPP/ 4096._RPP; c(8,4)= -45._RPP/32768._RPP ! stencil 4 + c(6,5)= 441._RPP/ 8192._RPP; c(7,5)= -45._RPP/ 4096._RPP; c(8,5)= 35._RPP/32768._RPP ! stencil 5 + c(6,6)= -495._RPP/ 8192._RPP; c(7,6)= 55._RPP/ 4096._RPP; c(8,6)= -45._RPP/32768._RPP ! stencil 6 + c(6,7)= 1001._RPP/ 8192._RPP; c(7,7)= -117._RPP/ 4096._RPP; c(8,7)= 99._RPP/32768._RPP ! stencil 7 + c(6,8)= -4095._RPP/ 8192._RPP; c(7,8)= 495._RPP/ 4096._RPP; c(8,8)= -429._RPP/32768._RPP ! stencil 8 + endselect + else + ! internal point + do k=0,S-1 !stencils loop + do j=0,S-1 !values loop + prod = 1._RPP + do i=0,S-1 + if (i==j) cycle + prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j+1) - stencil(-S+k+i+1))) + enddo + c(j,k) = prod enddo - c(j,k) = prod enddo - enddo - endif - endassociate + endif + endassociate + endselect endsubroutine create pure subroutine compute_with_stencil_of_rank_1(self, stencil) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index aa90e6d..911a2ad 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -34,11 +34,11 @@ module wenoof_kappa_int_js !< doi:10.1137/070679065. contains ! public deferred methods - procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute_kappa_rec !< Compute kappa. - procedure, pass(self) :: compute_kappa_int !< Compute kappa. - procedure, pass(self) :: description !< Return kappa string-description. - procedure, pass(self) :: destroy !< Destroy kappa. + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute_kappa_rec !< Compute kappa. + procedure, pass(self) :: compute_kappa_int !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_int_js contains @@ -54,7 +54,10 @@ subroutine create(self, constructor) call self%create_(constructor=constructor) allocate(self%values_rank_1(0:self%S - 1)) self%values_rank_1 = 0._RPP - call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) + select type(constructor) + type is(kappa_int_js_constructor) + call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) + endselect endsubroutine create pure subroutine compute_kappa_rec(self) @@ -66,13 +69,16 @@ pure subroutine compute_kappa_rec(self) pure subroutine compute_kappa_int(self, stencil, x_target) !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. - real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. - real(RPP) :: prod !< Temporary variable. - integer(I_P) :: i, j !< Counters. + class(kappa_int_js), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + class(interpolations_int_js) :: interpolations !< Interpolations object. + real(RPP), allocatable :: coef(:) !< Interpolation coefficients on the whole stencil. + real(RPP) :: prod !< Temporary variable. + real(RPP) :: coeff !< Temporary variable. + integer(I_P) :: i, j !< Counters. - associate(S => self%S, val => self%values_rank_1, c => interpolations_int_js%coef) + associate(S => self%S, val => self%values_rank_1, c => interpolations%coef) if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then ! left interface (i-1/2) select case(S) diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index 326ce75..c556d56 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -34,10 +34,11 @@ module wenoof_kappa_rec_js real(RPP), allocatable :: values(:,:) !< Kappa coefficients values [1:2,0:S-1]. contains ! public deferred methods - procedure, pass(self) :: create !< Create kappa. - procedure, pass(self) :: compute => compute_kappa_rec !< Compute kappa. - procedure, pass(self) :: description !< Return kappa string-description. - procedure, pass(self) :: destroy !< Destroy kappa. + procedure, pass(self) :: create !< Create kappa. + procedure, pass(self) :: compute_kappa_rec !< Compute kappa. + procedure, pass(self) :: compute_kappa_int !< Compute kappa. + procedure, pass(self) :: description !< Return kappa string-description. + procedure, pass(self) :: destroy !< Destroy kappa. endtype kappa_rec_js contains @@ -178,6 +179,15 @@ pure subroutine compute_kappa_rec(self) endassociate endsubroutine compute_kappa_rec + pure subroutine compute_kappa_int(self, stencil, x_target) + !< Compute kappa. + class(kappa_rec_js), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + + ! Empty Subroutine + endsubroutine compute_kappa_int + pure function description(self) result(string) !< Return string-description of kappa. class(kappa_rec_js), intent(in) :: self !< Kappa. diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index 2814c2c..2ec1caa 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -47,7 +47,7 @@ subroutine create_constructor_rec(interpolator_type, S, constructor) call constructor%create(S=S) endsubroutine create_constructor_rec - subroutine create_constructor(interpolator_type, S, stencil, x_target, constructor) + subroutine create_constructor_int(interpolator_type, S, stencil, x_target, constructor) !< Create an instance of concrete extension of [[beta_object_constructor]]. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencils dimension. @@ -59,5 +59,5 @@ subroutine create_constructor(interpolator_type, S, stencil, x_target, construct allocate(stencil :: constructor%stencil) constructor%x_target = x_target call constructor%create(S=S) - endsubroutine create_constructor + endsubroutine create_constructor_int endmodule wenoof_interpolations_factory From 470cc3b3f4b1dbaa9813300a5036056454597bf4 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 3 Mar 2017 20:05:25 +0100 Subject: [PATCH 47/90] fix blank space --- src/lib/concrete_objects/wenoof_weights_int_js.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 3750d36..5061bf6 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -63,7 +63,7 @@ module wenoof_weights_int_js ! deferred public methods subroutine create(self, constructor) !< Create reconstructor. - class(weights_int_js), intent(inout) :: self !< Weights. + class(weights_int_js), intent(inout) :: self !< Weights. class(base_object_constructor), intent(in) :: constructor !< Constructor. type(alpha_factory) :: a_factory !< Alpha factory. type(beta_factory) :: b_factory !< Beta factory. From 7a84a2d5ec5de98327cb9da97890ce0fadad0713 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 6 Mar 2017 16:00:50 +0100 Subject: [PATCH 48/90] correct wrong formula for k evluation --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 911a2ad..1601bee 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -204,10 +204,12 @@ pure subroutine compute_kappa_int(self, stencil, x_target) enddo do j = 0,S-1 coeff = 0._RPP - do i = 0, j-1 - coeff = coeff + val(i) * c(j,i) + k = j + do i = 0,j-1 + coeff = coeff + val(i) * c(k,i) + k = k - 1 enddo - val(j) = (coef(j) - coeff) / c(j,i) + val(j) = (coef(j) - coeff) / c(0,j) enddo deallocate(coef) endif From 69c014fb13540ea246b68df7c6f699fe45366986 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 6 Mar 2017 16:05:52 +0100 Subject: [PATCH 49/90] fix not declared variable --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 1601bee..fbc779c 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -76,7 +76,7 @@ pure subroutine compute_kappa_int(self, stencil, x_target) real(RPP), allocatable :: coef(:) !< Interpolation coefficients on the whole stencil. real(RPP) :: prod !< Temporary variable. real(RPP) :: coeff !< Temporary variable. - integer(I_P) :: i, j !< Counters. + integer(I_P) :: i, j, k !< Counters. associate(S => self%S, val => self%values_rank_1, c => interpolations%coef) if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then From ddafa4656e471dcedb286b604f8598c278964f5f Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 7 Mar 2017 15:02:32 +0100 Subject: [PATCH 50/90] removed FOLLIA from modules --- .gitmodules | 4 ---- src/third_party/FOLLIA | 1 - 2 files changed, 5 deletions(-) delete mode 160000 src/third_party/FOLLIA diff --git a/.gitmodules b/.gitmodules index 14cd88d..038d4ca 100644 --- a/.gitmodules +++ b/.gitmodules @@ -10,7 +10,3 @@ path = src/third_party/FLAP url = https://github.com/szaghi/FLAP branch = master -[submodule "src/third_party/FOLLIA"] - path = src/third_party/FOLLIA - url = https://github.com/giacombum/FOLLIA.git - branch = master diff --git a/src/third_party/FOLLIA b/src/third_party/FOLLIA deleted file mode 160000 index dd488fe..0000000 --- a/src/third_party/FOLLIA +++ /dev/null @@ -1 +0,0 @@ -Subproject commit dd488fe7dea640644a9d608e51ee2893578c30b9 From 4b30f2d7feed37a19b29e4b1d0fc3eaefa58f3de Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 7 Mar 2017 15:03:40 +0100 Subject: [PATCH 51/90] update PENF to latest commit --- src/third_party/PENF | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/third_party/PENF b/src/third_party/PENF index cfafeea..e4ddeb2 160000 --- a/src/third_party/PENF +++ b/src/third_party/PENF @@ -1 +1 @@ -Subproject commit cfafeeacc2dcef861f03fc9f7e287997df9aa139 +Subproject commit e4ddeb2c3f02047a371f909b4e0e69a2926550a2 From 7b264c8ba8aecf272cbda3d7fa863346f37805c0 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 7 Mar 2017 15:30:31 +0100 Subject: [PATCH 52/90] added interpolations object to kappa object --- .../wenoof_interpolator_js.F90 | 2 -- .../concrete_objects/wenoof_kappa_int_js.F90 | 22 +++++++++++++------ .../wenoof_weights_int_js.F90 | 10 ++++----- .../wenoof_interpolations_factory.f90 | 8 +++++-- 4 files changed, 26 insertions(+), 16 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index 91329c6..fe4bab6 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -49,14 +49,12 @@ subroutine create(self, constructor) !< Create interpolator. class(interpolator_js), intent(inout) :: self !< Interpolator. class(base_object_constructor), intent(in) :: constructor !< Constructor. - type(interpolations_factory) :: i_factory !< Inteprolations factory. type(weights_factory) :: w_factory !< Weights factory. call self%destroy call self%create_(constructor=constructor) select type(constructor) class is(interpolator_object_constructor) - call i_factory%create(constructor=constructor%interpolations_constructor, object=self%interpolations) call w_factory%create(constructor=constructor%weights_constructor, object=self%weights) endselect endsubroutine create diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index fbc779c..ea4588c 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -12,8 +12,10 @@ module wenoof_kappa_int_js use penf, only: I_P, RPP=>R8P #endif use wenoof_base_object -use wenoof_kappa_object +use wenoof_interpolations_factory +use wenoof_interpolations_object use wenoof_interpolations_int_js +use wenoof_kappa_object implicit none private @@ -22,8 +24,9 @@ module wenoof_kappa_int_js type, extends(kappa_object_constructor) :: kappa_int_js_constructor !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal kappa object constructor. - real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP) :: x_target !< Coordinate of the interpolation point. + real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP) :: x_target !< Coordinate of the interpolation point. + class(interpolations_object_constructor), allocatable :: interpolations_constructor !< interpolations coefficients constructor. endtype kappa_int_js_constructor type, extends(kappa_object):: kappa_int_js @@ -32,6 +35,7 @@ module wenoof_kappa_int_js !< @note The provided WENO kappa implements the linear weights defined in *High Order Weighted Essentially !< Nonoscillatory Schemes for Convection Dominated Problems*, Chi-Wang Shu, SIAM Review, 2009, vol. 51, pp. 82--126, !< doi:10.1137/070679065. + class(interpolations_object), allocatable :: interpolations !< interpolations coefficients. contains ! public deferred methods procedure, pass(self) :: create !< Create kappa. @@ -49,6 +53,7 @@ subroutine create(self, constructor) !< @note The kappa coefficients are also computed, they being constants. class(kappa_int_js), intent(inout) :: self !< Kappa. class(base_object_constructor), intent(in) :: constructor !< Kappa constructor. + type(interpolations_factory) :: i_factory !< Interpolations factory. call self%destroy call self%create_(constructor=constructor) @@ -56,7 +61,10 @@ subroutine create(self, constructor) self%values_rank_1 = 0._RPP select type(constructor) type is(kappa_int_js_constructor) - call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) + associate(interpolations_constructor=>constructor%interpolations_constructor) + call i_factory%create(constructor=interpolations_constructor, object=self%interpolations) + call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) + endassociate endselect endsubroutine create @@ -78,7 +86,7 @@ pure subroutine compute_kappa_int(self, stencil, x_target) real(RPP) :: coeff !< Temporary variable. integer(I_P) :: i, j, k !< Counters. - associate(S => self%S, val => self%values_rank_1, c => interpolations%coef) + associate(S => self%S, val => self%values_rank_1, interp => self%interpolations) if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then ! left interface (i-1/2) select case(S) @@ -206,10 +214,10 @@ pure subroutine compute_kappa_int(self, stencil, x_target) coeff = 0._RPP k = j do i = 0,j-1 - coeff = coeff + val(i) * c(k,i) + coeff = coeff + val(i) * interp%coef(k,i) k = k - 1 enddo - val(j) = (coef(j) - coeff) / c(0,j) + val(j) = (coef(j) - coeff) / interp%coef(0,j) enddo deallocate(coef) endif diff --git a/src/lib/concrete_objects/wenoof_weights_int_js.F90 b/src/lib/concrete_objects/wenoof_weights_int_js.F90 index 5061bf6..cc4a7d2 100644 --- a/src/lib/concrete_objects/wenoof_weights_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_weights_int_js.F90 @@ -14,16 +14,16 @@ module wenoof_weights_int_js #endif use wenoof_alpha_factory use wenoof_alpha_object -use wenoof_alpha_rec_js -use wenoof_alpha_rec_m -use wenoof_alpha_rec_z +use wenoof_alpha_int_js +use wenoof_alpha_int_m +use wenoof_alpha_int_z use wenoof_base_object use wenoof_beta_factory use wenoof_beta_object -use wenoof_beta_rec_js +use wenoof_beta_int_js use wenoof_kappa_factory use wenoof_kappa_object -use wenoof_kappa_rec_js +use wenoof_kappa_int_js use wenoof_weights_object implicit none diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index 2ec1caa..3513cf9 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -2,7 +2,11 @@ module wenoof_interpolations_factory !< Wenoof interpolations factory. -use penf, only: I_P +#ifdef r16p +use penf, only: I_P, RPP=>R16P +#else +use penf, only: I_P, RPP=>R8P +#endif use wenoof_interpolations_object use wenoof_interpolations_rec_js use wenoof_interpolations_int_js @@ -56,7 +60,7 @@ subroutine create_constructor_int(interpolator_type, S, stencil, x_target, const class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. allocate(interpolations_int_js_constructor :: constructor) - allocate(stencil :: constructor%stencil) + allocate(stencil :: constructor%stencil) constructor%x_target = x_target call constructor%create(S=S) endsubroutine create_constructor_int From d869b92a7e2f83cbd642a79f229fd858d56e574c Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 7 Mar 2017 17:31:53 +0100 Subject: [PATCH 53/90] add interpolations constructor --- src/lib/factories/wenoof_objects_factory.f90 | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/lib/factories/wenoof_objects_factory.f90 b/src/lib/factories/wenoof_objects_factory.f90 index 1461548..8aaada0 100644 --- a/src/lib/factories/wenoof_objects_factory.f90 +++ b/src/lib/factories/wenoof_objects_factory.f90 @@ -180,10 +180,11 @@ subroutine create_interpolator(self, interpolator_type, S, interpolator, stencil x_target=x_target, & constructor=interpolations_constructor) - call self%create_constructor(interpolator_type=interpolator_type, & - S=S, & - stencil=stencil, & - x_target=x_target, & + call self%create_constructor(interpolator_type=interpolator_type, & + S=S, & + stencil=stencil, & + x_target=x_target, & + interpolations_constructor=interpolations_constructor, & constructor=kappa_constructor) call self%create_constructor(interpolator_type=interpolator_type, & From 854326a5b8b1d49005ceaa643ef91488e1e5d21f Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 8 Mar 2017 09:17:16 +0100 Subject: [PATCH 54/90] modified abstract kappa and interpolations objects --- src/lib/abstract_objects/wenoof_interpolations_object.F90 | 2 ++ src/lib/abstract_objects/wenoof_kappa_object.F90 | 2 ++ src/lib/concrete_objects/wenoof_interpolations_int_js.F90 | 2 -- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 2 -- src/lib/factories/wenoof_interpolations_factory.f90 | 6 +++--- 5 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_interpolations_object.F90 b/src/lib/abstract_objects/wenoof_interpolations_object.F90 index bf35384..998666e 100644 --- a/src/lib/abstract_objects/wenoof_interpolations_object.F90 +++ b/src/lib/abstract_objects/wenoof_interpolations_object.F90 @@ -16,6 +16,8 @@ module wenoof_interpolations_object type, extends(base_object_constructor), abstract :: interpolations_object_constructor !< Abstract interpolations object constructor. + real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP) :: x_target !< Coordinate of the interpolation point. endtype interpolations_object_constructor type, extends(base_object), abstract :: interpolations_object diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index 76427c9..b0ac678 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -16,6 +16,8 @@ module wenoof_kappa_object type, extends(base_object_constructor), abstract :: kappa_object_constructor !< Abstract kappa object constructor. + real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP) :: x_target !< Coordinate of the interpolation point. endtype kappa_object_constructor type, extends(base_object), abstract :: kappa_object diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index f993854..9a2e38c 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -21,8 +21,6 @@ module wenoof_interpolations_int_js type, extends(interpolations_object_constructor) :: interpolations_int_js_constructor !< Jiang-Shu (Lagrange) interpolations object for function interpolation constructor. - real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP) :: x_target !< Coordinate of the interpolation point. endtype interpolations_int_js_constructor type, extends(interpolations_object) :: interpolations_int_js diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index ea4588c..1d2dcc1 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -24,8 +24,6 @@ module wenoof_kappa_int_js type, extends(kappa_object_constructor) :: kappa_int_js_constructor !< Jiang-Shu and Gerolymos-Senechal-Vallet optimal kappa object constructor. - real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP) :: x_target !< Coordinate of the interpolation point. class(interpolations_object_constructor), allocatable :: interpolations_constructor !< interpolations coefficients constructor. endtype kappa_int_js_constructor diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index 3513cf9..bd8dc1d 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -19,9 +19,9 @@ module wenoof_interpolations_factory !< Factory, create an instance of concrete extension of [[interpolations_object]] given its constructor. contains ! public methods - procedure, nopass :: create !< Create a concrete instance of [[interpolations_object]]. - procedure, nopass, generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance - create_constructor_int !< of [[interpolations_object_constructor]]. + procedure, nopass :: create !< Create a concrete instance of [[interpolations_object]]. + generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance + create_constructor_int !< of [[interpolations_object_constructor]]. endtype interpolations_factory contains From 3c96f39e1bddd25eda38ce6f64aa1ff403faf782 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 13 Mar 2017 10:27:36 +0100 Subject: [PATCH 55/90] minor fixes --- .../concrete_objects/wenoof_kappa_int_js.F90 | 17 ++++++++--------- .../factories/wenoof_interpolations_factory.f90 | 7 +++++-- src/lib/factories/wenoof_kappa_factory.f90 | 8 +++++--- 3 files changed, 18 insertions(+), 14 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 1d2dcc1..00219d9 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -78,10 +78,9 @@ pure subroutine compute_kappa_int(self, stencil, x_target) class(kappa_int_js), intent(inout) :: self !< Kappa. real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. - class(interpolations_int_js) :: interpolations !< Interpolations object. - real(RPP), allocatable :: coef(:) !< Interpolation coefficients on the whole stencil. + real(RPP), allocatable :: coeff(:) !< Interpolation coefficients on the whole stencil. real(RPP) :: prod !< Temporary variable. - real(RPP) :: coeff !< Temporary variable. + real(RPP) :: coeff_t !< Temporary variable. integer(I_P) :: i, j, k !< Counters. associate(S => self%S, val => self%values_rank_1, interp => self%interpolations) @@ -199,25 +198,25 @@ pure subroutine compute_kappa_int(self, stencil, x_target) endselect else ! internal point - allocate(coef(0:2*S-2)) + allocate(coeff(0:2*S-2)) do j=0,2*S-2 !values loop prod = 1._RPP do i=0,2*S-2 if (i==j) cycle prod = prod * ((x_target - stencil(-S+i+1)) / (stencil(-S+j+1) - stencil(-S+i+1))) enddo - coef(j) = prod + coeff(j) = prod enddo do j = 0,S-1 - coeff = 0._RPP + coeff_t = 0._RPP k = j do i = 0,j-1 - coeff = coeff + val(i) * interp%coef(k,i) + coeff_t = coeff_t + val(i) * interp%coef(k,i) k = k - 1 enddo - val(j) = (coef(j) - coeff) / interp%coef(0,j) + val(j) = (coeff(j) - coeff_t) / interp%coef(0,j) enddo - deallocate(coef) + deallocate(coeff) endif endassociate endsubroutine compute_kappa_int diff --git a/src/lib/factories/wenoof_interpolations_factory.f90 b/src/lib/factories/wenoof_interpolations_factory.f90 index bd8dc1d..1f36047 100644 --- a/src/lib/factories/wenoof_interpolations_factory.f90 +++ b/src/lib/factories/wenoof_interpolations_factory.f90 @@ -19,7 +19,9 @@ module wenoof_interpolations_factory !< Factory, create an instance of concrete extension of [[interpolations_object]] given its constructor. contains ! public methods - procedure, nopass :: create !< Create a concrete instance of [[interpolations_object]]. + procedure, nopass :: create !< Create a concrete instance of [[interpolations_object]]. + procedure, nopass :: create_constructor_rec + procedure, nopass :: create_constructor_int generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance create_constructor_int !< of [[interpolations_object_constructor]]. endtype interpolations_factory @@ -60,7 +62,8 @@ subroutine create_constructor_int(interpolator_type, S, stencil, x_target, const class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. allocate(interpolations_int_js_constructor :: constructor) - allocate(stencil :: constructor%stencil) + allocate(constructor%stencil(1-S:S-1)) + constructor%stencil = stencil constructor%x_target = x_target call constructor%create(S=S) endsubroutine create_constructor_int diff --git a/src/lib/factories/wenoof_kappa_factory.f90 b/src/lib/factories/wenoof_kappa_factory.f90 index 4e7f689..9e64470 100644 --- a/src/lib/factories/wenoof_kappa_factory.f90 +++ b/src/lib/factories/wenoof_kappa_factory.f90 @@ -15,9 +15,11 @@ module wenoof_kappa_factory !< Factory, create an instance of concrete extension of [[kappa_object]] given its constructor. contains ! public methods - procedure, nopass :: create !< Create a concrete instance of [[kappa_object]]. - procedure, nopass, generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance - create_constructor_int !< of [[kappa_object_constructor]]. + procedure, nopass :: create !< Create a concrete instance of [[kappa_object]]. + procedure, nopass :: create_constructor_rec + procedure, nopass :: create_constructor_int + generic :: create_constructor => create_constructor_rec, & !< Create a concrete instance + create_constructor_int !< of [[kappa_object_constructor]]. endtype kappa_factory contains From ed3d0bca3cbfc47b352de51fea3e589c2293ea31 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 13 Mar 2017 15:12:55 +0100 Subject: [PATCH 56/90] First compiling version of interpolator --- .../concrete_objects/wenoof_kappa_int_js.F90 | 21 +++--- src/lib/factories/wenoof_kappa_factory.f90 | 23 ++++--- src/lib/factories/wenoof_objects_factory.f90 | 67 ++++++++++--------- src/lib/wenoof.F90 | 9 ++- 4 files changed, 70 insertions(+), 50 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 00219d9..d373edc 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -207,15 +207,18 @@ pure subroutine compute_kappa_int(self, stencil, x_target) enddo coeff(j) = prod enddo - do j = 0,S-1 - coeff_t = 0._RPP - k = j - do i = 0,j-1 - coeff_t = coeff_t + val(i) * interp%coef(k,i) - k = k - 1 - enddo - val(j) = (coeff(j) - coeff_t) / interp%coef(0,j) - enddo + select type(interp) + type is(interpolations_int_js) + do j = 0,S-1 + coeff_t = 0._RPP + k = j + do i = 0,j-1 + coeff_t = coeff_t + val(i) * interp%coef(k,i) + k = k - 1 + enddo + val(j) = (coeff(j) - coeff_t) / interp%coef(0,j) + enddo + endselect deallocate(coeff) endif endassociate diff --git a/src/lib/factories/wenoof_kappa_factory.f90 b/src/lib/factories/wenoof_kappa_factory.f90 index 9e64470..bc918b6 100644 --- a/src/lib/factories/wenoof_kappa_factory.f90 +++ b/src/lib/factories/wenoof_kappa_factory.f90 @@ -2,7 +2,12 @@ module wenoof_kappa_factory !< Wenoof kappa factory. -use penf, only: I_P +#ifdef r16p +use penf, only: I_P, RPP=>R16P +#else +use penf, only: I_P, RPP=>R8P +#endif +use wenoof_interpolations_object use wenoof_kappa_object use wenoof_kappa_rec_js use wenoof_kappa_int_js @@ -49,16 +54,18 @@ subroutine create_constructor_rec(interpolator_type, S, constructor) call constructor%create(S=S) endsubroutine create_constructor_rec - subroutine create_constructor_int(interpolator_type, S, stencil, x_target, constructor) + subroutine create_constructor_int(interpolator_type, S, stencil, x_target, interpolations_constructor, constructor) !< Create an instance of concrete extension of [[kappa_object_constructor]]. - character(*), intent(in) :: interpolator_type !< Type of the interpolator. - integer(I_P), intent(in) :: S !< Stencils dimension. - real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. - real(RPP), intent(in) :: x_target !< Coordinate of the interp point. - class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. + class(interpolations_object_constructor), intent(in) :: interpolations_constructor !< interpolations constructor. + class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. allocate(kappa_int_js_constructor :: constructor) - allocate(stencil :: constructor%stencil) + allocate(constructor%stencil(1-S:S-1)) + constructor%stencil = stencil constructor%x_target = x_target call constructor%create(S=S) endsubroutine create_constructor_int diff --git a/src/lib/factories/wenoof_objects_factory.f90 b/src/lib/factories/wenoof_objects_factory.f90 index 8aaada0..58007c7 100644 --- a/src/lib/factories/wenoof_objects_factory.f90 +++ b/src/lib/factories/wenoof_objects_factory.f90 @@ -52,19 +52,22 @@ module wenoof_objects_factory !< [[interpolator_object_constructor]] or !< [[weights_object_constructor]]. ! private methods - procedure, nopass, private :: create_alpha_object !< Create [[alpha_object]] instance - procedure, nopass, private :: create_beta_object !< Create [[beta_object]] instance. - procedure, nopass, private :: create_kappa_object !< Create [[kappa_object]] instance. - procedure, nopass, private :: create_interpolations_object !< Create [[interpolations_object]] instance. - procedure, pass(self), private :: create_interpolator !< Create [[interpolator_object]] instance. - procedure, nopass, private :: create_interpolator_object !< Create [[interpolator_object]] instance. - procedure, nopass, private :: create_weights_object !< Create [[weights_object]] instance. - procedure, nopass, private :: create_alpha_object_constructor !< Create [[alpha_object_constructor]] instance. - procedure, nopass, private :: create_beta_object_constructor !< Create [[beta_object_constructor]] instance. - procedure, nopass, private :: create_kappa_object_constructor !< Create [[kappa_object_constructor]] instance. - procedure, nopass, private :: create_interpolations_object_constructor !< Create [[interpolations_object_constructor]] inst. - procedure, nopass, private :: create_interpolator_object_constructor !< Create [[interpolator_object_constructor]] inst. - procedure, nopass, private :: create_weights_object_constructor !< Create [[weights_object_constructor]] instance. + procedure, nopass, private :: create_alpha_object !< Create [[alpha_object]] instance + procedure, nopass, private :: create_beta_object !< Create [[beta_object]] instance. + procedure, nopass, private :: create_kappa_object !< Create [[kappa_object]] instance. + procedure, nopass, private :: create_interpolations_object !< Create [[interpolations_object]] instance. + procedure, pass(self), private :: create_interpolator !< Create [[interpolator]] instance. + procedure, pass(self), private :: create_reconstructor !< Create [[reconstructor]] instance. + procedure, nopass, private :: create_interpolator_object !< Create [[interpolator_object]] instance. + procedure, nopass, private :: create_weights_object !< Create [[weights_object]] instance. + procedure, nopass, private :: create_alpha_object_constructor !< Create [[alpha_object_constructor]] instance. + procedure, nopass, private :: create_beta_object_constructor !< Create [[beta_object_constructor]] instance. + procedure, nopass, private :: create_kappa_int_object_constructor !< Create [[kappa_object_constructor]] instance. + procedure, nopass, private :: create_kappa_rec_object_constructor !< Create [[kappa_object_constructor]] instance. + procedure, nopass, private :: create_interpolations_int_object_constructor !< Create [[interpolations_object_constructor]] + procedure, nopass, private :: create_interpolations_rec_object_constructor !< instance. + procedure, nopass, private :: create_interpolator_object_constructor !< Create [[interpolator_object_constructor]] i. + procedure, nopass, private :: create_weights_object_constructor !< Create [[weights_object_constructor]] inst. endtype objects_factory contains @@ -149,7 +152,7 @@ subroutine create_reconstructor(self, interpolator_type, S, interpolator, eps) call self%create_interpolator_object(constructor=interpolator_constructor, object=interpolator) endsubroutine create_reconstructor - subroutine create_interpolator(self, interpolator_type, S, interpolator, stencil, xtarget, eps) + subroutine create_interpolator(self, interpolator_type, S, interpolator, stencil, x_target, eps) !< Create an instance of concrete extension of [[interpolator_object]] given user options. class(objects_factory), intent(in) :: self !< The factory. character(*), intent(in) :: interpolator_type !< Type of the interpolator. @@ -247,19 +250,21 @@ subroutine create_beta_object_constructor(interpolator_type, S, constructor) constructor=constructor) endsubroutine create_beta_object_constructor - subroutine create_kappa_int_object_constructor(interpolator_type, S, stencil, x_target, constructor) + subroutine create_kappa_int_object_constructor(interpolator_type, S, stencil, x_target, interpolations_constructor, constructor) !< Create an instance of concrete extension of [[kappa_object_constructor]]. - character(*), intent(in) :: interpolator_type !< Type of the interpolator. - integer(I_P), intent(in) :: S !< Stencils dimension. - real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. - real(RPP), intent(in) :: x_target !< Coordinate of the interp point. - class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - type(kappa_factory) :: factory !< The factory. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. + class(interpolations_object_constructor), intent(in) :: interpolations_constructor !< interpolations constructor. + class(kappa_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + type(kappa_factory) :: factory !< The factory. - call factory%create_constructor(interpolator_type=interpolator_type, & - S=S, & - stencil=stencil, & - x_target=x_target, & + call factory%create_constructor(interpolator_type=interpolator_type, & + S=S, & + stencil=stencil, & + x_target=x_target, & + interpolations_constructor=interpolations_constructor, & constructor=constructor) endsubroutine create_kappa_int_object_constructor @@ -289,12 +294,12 @@ subroutine create_interpolations_rec_object_constructor(interpolator_type, S, co subroutine create_interpolations_int_object_constructor(interpolator_type, S, stencil, x_target, constructor) !< Create an instance of concrete extension of [[interpolations_object_constructor]]. - character(*), intent(in) :: interpolator_type !< Type of the interpolator. - integer(I_P), intent(in) :: S !< Stencils dimension. - real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. - real(RPP), intent(in) :: x_target !< Coordinate of the interp point. - class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. - type(interpolations_factory) :: factory !< The factory. + character(*), intent(in) :: interpolator_type !< Type of the interpolator. + integer(I_P), intent(in) :: S !< Stencils dimension. + real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for inter, [1-S:-1+S]. + real(RPP), intent(in) :: x_target !< Coordinate of the interp point. + class(interpolations_object_constructor), allocatable, intent(out) :: constructor !< Constructor. + type(interpolations_factory) :: factory !< The factory. call factory%create_constructor(interpolator_type=interpolator_type, & S=S, & diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index c81b057..a0eb59c 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -12,8 +12,13 @@ module wenoof implicit none private -public :: interpolator_object -generic, public :: wenoof_create => wenoof_create_reconstructor, wenoof_create_interpolator +public :: interpolator_object +public :: wenoof_create + +interface wenoof_create + module procedure wenoof_create_reconstructor + module procedure wenoof_create_interpolator +end interface wenoof_create contains subroutine wenoof_create_reconstructor(interpolator_type, S, interpolator, eps) From 57f3389f30c919f2e6054bd6b92b07f400e39afb Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 13 Mar 2017 15:22:09 +0100 Subject: [PATCH 57/90] update FLAP to last version --- src/third_party/FLAP | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/third_party/FLAP b/src/third_party/FLAP index 9d42d40..0069a3b 160000 --- a/src/third_party/FLAP +++ b/src/third_party/FLAP @@ -1 +1 @@ -Subproject commit 9d42d406c55c32ae13f30a87ca556eec0c819fdd +Subproject commit 0069a3b8026db5c1331e0b2adfce92250eb1846d From 59d81920b580064fe6f37519e27eb4488047099a Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 13 Mar 2017 15:44:12 +0100 Subject: [PATCH 58/90] Removed submodule FOODIE --- src/third_party/FOODIE | 1 - 1 file changed, 1 deletion(-) delete mode 160000 src/third_party/FOODIE diff --git a/src/third_party/FOODIE b/src/third_party/FOODIE deleted file mode 160000 index 10113d3..0000000 --- a/src/third_party/FOODIE +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 10113d3a009609f3529f11dab96d364d6e3c9e7b From f13adb6373cb9855c2add2ea2cff4b6bfdbb9955 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 15 Mar 2017 08:14:48 +0100 Subject: [PATCH 59/90] Add FACE submodule --- .gitmodules | 3 +++ src/third_party/FACE | 1 + 2 files changed, 4 insertions(+) create mode 160000 src/third_party/FACE diff --git a/.gitmodules b/.gitmodules index 038d4ca..cabb366 100644 --- a/.gitmodules +++ b/.gitmodules @@ -10,3 +10,6 @@ path = src/third_party/FLAP url = https://github.com/szaghi/FLAP branch = master +[submodule "src/third_party/FACE"] + path = src/third_party/FACE + url = https://github.com/szaghi/FACE.git diff --git a/src/third_party/FACE b/src/third_party/FACE new file mode 160000 index 0000000..bc82908 --- /dev/null +++ b/src/third_party/FACE @@ -0,0 +1 @@ +Subproject commit bc8290874430b454ec57e255185ba1ab7419766f From 0b7ed2107b101155db2d7c7cb5239c80b705a165 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 15 Mar 2017 08:16:50 +0100 Subject: [PATCH 60/90] Add FOODIE submodule --- .gitmodules | 3 +++ src/third_party/FOODIE | 1 + 2 files changed, 4 insertions(+) create mode 160000 src/third_party/FOODIE diff --git a/.gitmodules b/.gitmodules index cabb366..4e06805 100644 --- a/.gitmodules +++ b/.gitmodules @@ -13,3 +13,6 @@ [submodule "src/third_party/FACE"] path = src/third_party/FACE url = https://github.com/szaghi/FACE.git +[submodule "src/third_party/FOODIE"] + path = src/third_party/FOODIE + url = https://github.com/Fortran-FOSS-Programmers/FOODIE.git diff --git a/src/third_party/FOODIE b/src/third_party/FOODIE new file mode 160000 index 0000000..10113d3 --- /dev/null +++ b/src/third_party/FOODIE @@ -0,0 +1 @@ +Subproject commit 10113d3a009609f3529f11dab96d364d6e3c9e7b From 7281e5b9fff63367e8bceb09c62f4c930902f16d Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Tue, 14 Mar 2017 18:55:44 +0100 Subject: [PATCH 61/90] sanitize fobos --- fobos | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/fobos b/fobos index d6cbb5a..037edfb 100644 --- a/fobos +++ b/fobos @@ -13,9 +13,11 @@ $CSTATIC_INT = -cpp -c -assume realloc_lhs $DEBUG_GNU = -Og -g3 -Warray-bounds -Wcharacter-truncation -Wline-truncation -Wimplicit-interface -Wimplicit-procedure -Wunderflow -fcheck=all -fmodule-private -ffree-line-length-132 -fimplicit-none -fbacktrace -fdump-core -finit-real=nan -std=f2008 -fall-intrinsics $DEBUG_INT = -O0 -debug all -check all -warn all -extend-source 132 -traceback -gen-interfaces#-fpe-all=0 -fp-stack-check -fstack-protector-all -ftrapuv -no-ftz -std08 $OPTIMIZE = -O2 -$EXDIRS = FLAP/src/tests/ FLAP/src/third_party/ - PENF/src/tests/ pyplot-fortran/src/tests/ - FOODIE/src/tests/ FOODIE/src/third_party/ +$EXDIRS = FACE/src/tests FACE/src/third_party/ + FLAP/src/tests/ FLAP/src/third_party/ + PENF/src/tests/ PENF/src/third_party/ + FOODIE/src/tests FOODIE/src/third_party/ + pyplot-fortran/src/tests/ # main modes # GNU From aa4804536ec0dcf9234001d920b86d0c6eaba8c9 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 16 Mar 2017 14:05:58 +0100 Subject: [PATCH 62/90] modified interpolator API --- .../wenoof_interpolations_int_js.F90 | 4 ++-- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 4 ++-- src/lib/wenoof.F90 | 14 +++++++++++--- 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index 9a2e38c..f048d76 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -56,7 +56,7 @@ subroutine create(self, constructor) select type(constructor) type is(interpolations_int_js_constructor) associate(S => self%S, c => self%coef, stencil => constructor%stencil, x_target => constructor%x_target) - if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then + if(x_target==-0.5_RPP) then ! left interface (i-1/2) select case(S) case(2) ! 3rd order @@ -187,7 +187,7 @@ subroutine create(self, constructor) c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 endselect - elseif((x_target-(stencil(0)+stencil(1))/2._RPP)<10._RPP**(-10)) then + elseif(x_target==0.5_RPP) then ! right interface (i+1/2) select case(self%S) case(2) ! 3rd order diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index d373edc..d5d1e35 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -84,7 +84,7 @@ pure subroutine compute_kappa_int(self, stencil, x_target) integer(I_P) :: i, j, k !< Counters. associate(S => self%S, val => self%values_rank_1, interp => self%interpolations) - if((x_target-(stencil(0)+stencil(-1))/2._RPP)<10._RPP**(-10)) then + if(x_target==-0.5_RPP) then ! left interface (i-1/2) select case(S) case(2) ! 3rd order @@ -140,7 +140,7 @@ pure subroutine compute_kappa_int(self, stencil, x_target) val(7) = 17._RPP/8192._RPP ! stencil 7 val(8) = 1._RPP/65536._RPP ! stencil 8 endselect - elseif((x_target-(stencil(0)+stencil(1))/2._RPP)<10._RPP**(-10)) then + elseif(x_target==0.5_RPP) then ! right interface (i+1/2) select case(S) case(2) ! 3rd order diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index a0eb59c..d3130da 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -35,16 +35,24 @@ subroutine wenoof_create_reconstructor(interpolator_type, S, interpolator, eps) eps=eps) endsubroutine wenoof_create_reconstructor - subroutine wenoof_create_interpolator(interpolator_type, S, interpolator, stencil, x_target, eps) + subroutine wenoof_create_interpolator(interpolator_type, S, x_target, interpolator, eps) !< WenOOF creator, create a concrete WENO interpolator object. character(*), intent(in) :: interpolator_type !< Type of the interpolator. integer(I_P), intent(in) :: S !< Stencil dimension. - class(interpolator_object), allocatable, intent(out) :: interpolator !< The concrete WENO interpolator. - real(RPP), intent(in) :: stencil(1-S:) !< Stencil used for interpolation, [1-S:-1+S]. real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + class(interpolator_object), allocatable, intent(out) :: interpolator !< The concrete WENO interpolator. real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero-div. + real(RPP), allocatable :: stencil(:) !< Stencil used for interpolation, [1-S:-1+S]. + integer(I_P) :: i !< Counter. type(objects_factory) :: factory !< The factory. + if ((x_target < -0.5_RPP).or.(x_target > 0.5_RPP)) then + error stop 'error: x_target must be between -0.5 and 0.5, that represent left and right cell interfaces' + endif + allocate(stencil(1-S:S-1)) + do i=0,2*S-2 + stencil(i) = 1.0_RPP - S + i + enddo call factory%create(interpolator_type='interpolator-'//interpolator_type, & S=S, & interpolator=interpolator, & From aa5314e6271bf9616e1b5631a2f7f2349278ab9d Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Fri, 17 Mar 2017 23:01:35 +0100 Subject: [PATCH 63/90] new test user interface; compile but doesn't work --- src/tests/cos_reconstruction.f90 | 333 ---------------- src/tests/polynoms_interpolation.f90 | 360 ----------------- src/tests/polynoms_reconstruction.f90 | 357 ----------------- src/tests/polynoms_test.f90 | 537 ++++++++++++++++++++++++++ src/tests/sin_interpolation.f90 | 333 ---------------- src/tests/sin_test.f90 | 509 ++++++++++++++++++++++++ src/tests/wenoof_test_ui.f90 | 126 ++++-- 7 files changed, 1144 insertions(+), 1411 deletions(-) delete mode 100644 src/tests/cos_reconstruction.f90 delete mode 100644 src/tests/polynoms_interpolation.f90 delete mode 100644 src/tests/polynoms_reconstruction.f90 create mode 100644 src/tests/polynoms_test.f90 delete mode 100644 src/tests/sin_interpolation.f90 create mode 100644 src/tests/sin_test.f90 diff --git a/src/tests/cos_reconstruction.f90 b/src/tests/cos_reconstruction.f90 deleted file mode 100644 index 6234e04..0000000 --- a/src/tests/cos_reconstruction.f90 +++ /dev/null @@ -1,333 +0,0 @@ -!< WenOOF test: reconstruction of cosine function. -module cos_test_module -!< Auxiliary module defining the test class. - -use flap, only : command_line_interface -#ifdef r16p -use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz -#else -use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz -#endif -use pyplot_module, only : pyplot -use wenoof, only : interpolator_object, wenoof_create -use wenoof_test_ui, only : test_ui - -implicit none -private -public :: test - -real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. - -type :: solution_data - !< Class to handle solution data. - real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. - real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. - real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. - real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. - real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. - real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. - real(RPP), allocatable :: reconstruction(:) !< Reconstruction values [1:2,1:points_number]. - real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. - real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). - real(RPP) :: error_L2=0._RPP !< L2 norm of the numerical error. -endtype solution_data - -type :: test - !< Class to handle test(s). - !< - !< Test is driven by the Command Line Interface (CLI) options. - !< - !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. - private - type(test_ui) :: ui !< Command line interface handler. - type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. - real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. - contains - ! public methods - procedure, pass(self) :: execute !< Execute selected test(s). - ! private methods - procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. - procedure, pass(self), private :: analize_errors !< Analize errors. - procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. - procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. - procedure, pass(self), private :: perform !< Perform test(s). - procedure, pass(self), private :: save_results_and_plots !< Save results and plots. -endtype test - -contains - ! public methods - subroutine execute(self) - !< Execute test(s). - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - - call self%ui%get - if (trim(adjustl(self%ui%interpolator_type))/='all') then - call self%perform - else - do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) - call self%perform - enddo - endif - endsubroutine execute - - ! private methods - subroutine allocate_solution_data(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - - call self%deallocate_solution_data - allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) - if (self%ui%pn_number>1) then - allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) - self%accuracy = 0._RPP - endif - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%reconstruction( 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - self%solution(pn, s)%x_cell = 0._RPP - self%solution(pn, s)%fx_cell = 0._RPP - self%solution(pn, s)%x_face = 0._RPP - self%solution(pn, s)%fx_face = 0._RPP - self%solution(pn, s)%dfx_cell = 0._RPP - self%solution(pn, s)%interpolations = 0._RPP - self%solution(pn, s)%reconstruction = 0._RPP - self%solution(pn, s)%si = 0._RPP - self%solution(pn, s)%weights = 0._RPP - enddo - enddo - endsubroutine allocate_solution_data - - subroutine compute_reference_solution(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%allocate_solution_data - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - self%solution(pn, s)%Dx = 2 * pi / self%ui%points_number(pn) - ! compute the values used for the interpolation/reconstruction of cos function: cell values - do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) - self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) - enddo - ! values to which the interpolation/reconstruction should tend - do i = 1, self%ui%points_number(pn) - self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = sin(self%solution(pn, s)%x_face(1,i)) - self%solution(pn, s)%fx_face(2,i) = sin(self%solution(pn, s)%x_face(2,i)) - self%solution(pn, s)%dfx_cell(i) = cos(self%solution(pn, s)%x_cell(i)) - enddo - enddo - enddo - endsubroutine compute_reference_solution - - subroutine deallocate_solution_data(self) - !< Deallocate solution data. - class(test), intent(inout) :: self !< Test. - - if (allocated(self%solution)) deallocate(self%solution) - if (allocated(self%accuracy)) deallocate(self%accuracy) - endsubroutine deallocate_solution_data - - subroutine perform(self) - !< Perform the test. - class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. - class(interpolator_object), allocatable :: interpolator !< WENO interpolator. - real(RPP), allocatable :: stencil(:,:) !< Stencils used. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%compute_reference_solution - do s=1, self%ui%S_number - call wenoof_create(interpolator_type='reconstructor-'//trim(adjustl(self%ui%interpolator_type)), & - S=self%ui%S(s), & - interpolator=interpolator, & - eps=self%ui%eps) - if (self%ui%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) - do pn=1, self%ui%pn_number - do i=1, self%ui%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) - self%solution(pn, s)%reconstruction(i) = & - (self%solution(pn, s)%interpolations(2,i) - self%solution(pn, s)%interpolations(1,i))/self%solution(pn, s)%Dx - enddo - enddo - deallocate(stencil) - enddo - call self%analize_errors - call self%save_results_and_plots - endsubroutine perform - - subroutine save_results_and_plots(self) - !< Save results and plots. - class(test), intent(inout) :: self !< Test. - type(pyplot) :: plt !< Plot handler. - character(len=:), allocatable :: buffer !< Buffer string. - character(len=:), allocatable :: output_dir !< Output directory. - character(len=:), allocatable :: file_bname !< File base name. - integer(I_P) :: file_unit !< File unit. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: ss !< Counter. - integer(I_P) :: f !< Counter. - - output_dir = trim(adjustl(self%ui%output_dir))//'/' - if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-'//trim(adjustl(self%ui%interpolator_type)) - - if (self%ui%results) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') - buffer = 'VARIABLES = "x" "sin(x)" "cos(x)" "x_left" "x_right" "sin(x)_left" "sin(x)_right"' - buffer = buffer//' "reconstruction_left" "reconstruction_right" "cos_reconstruction"' - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' - enddo - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' - enddo - write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' - associate(x_cell => self%solution(pn, s)%x_cell, & - fx_cell => self%solution(pn, s)%fx_cell, & - dfx_cell => self%solution(pn, s)%dfx_cell, & - x_face => self%solution(pn, s)%x_face, & - fx_face => self%solution(pn, s)%fx_face, & - interpolations => self%solution(pn, s)%interpolations, & - reconstruction => self%solution(pn, s)%reconstruction, & - si => self%solution(pn, s)%si, & - weights => self%solution(pn, s)%weights, & - Dx => self%solution(pn, s)%Dx) - do i = 1, self%ui%points_number(pn) - write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - dfx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (interpolations(f,i), f=1, 2), & - reconstruction(i), & - ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) - enddo - endassociate - close(file_unit) - enddo - enddo - - if (self%ui%errors_analysis.and.self%ui%pn_number>1) then - open(newunit=file_unit, file=file_bname//'-accuracy.dat') - write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & - self%ui%points_number(pn), & - self%solution(pn, s)%error_L2, & - self%accuracy(pn, s), & - 2*self%ui%S(s)-1 - enddo - enddo - close(file_unit) - endif - endif - -#ifndef r16p - ! pyplot fortran does not support 128 bit reals - if (self%ui%plots) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - buffer = 'WENO reconstruction of $d \sin(x)/Dx=\cos(x)$; '//& - 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) - call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%dfx_cell(:), & - label='$\cos(x)$', & - linestyle='k-', & - linewidth=2, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%reconstruction(:), & - label='WENO reconstruction', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%savefig(file_bname//& - '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') - enddo - enddo - endif -#endif - endsubroutine save_results_and_plots - - subroutine analize_errors(self) - !< Analize errors. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - if (self%ui%errors_analysis) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - associate(error_L2=>self%solution(pn, s)%error_L2, & - Dx=>self%solution(pn, s)%Dx, & - dfx_cell=>self%solution(pn, s)%dfx_cell, & - reconstruction=>self%solution(pn, s)%reconstruction) - error_L2 = 0._RPP - do i=1, self%ui%points_number(pn) - error_L2 = error_L2 + (reconstruction(i) - dfx_cell(i))**2 - enddo - error_L2 = sqrt(error_L2) - endassociate - enddo - enddo - if (self%ui%pn_number>1) then - do s=1, self%ui%S_number - do pn=2, self%ui%pn_number - self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & - log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) - enddo - enddo - endif - endif - endsubroutine analize_errors -endmodule cos_test_module - -program cos_reconstruction -!< WenOOF test: reconstruction of cosine function. - -use cos_test_module - -implicit none -type(test) :: cos_test - -call cos_test%execute -endprogram cos_reconstruction diff --git a/src/tests/polynoms_interpolation.f90 b/src/tests/polynoms_interpolation.f90 deleted file mode 100644 index cf567a9..0000000 --- a/src/tests/polynoms_interpolation.f90 +++ /dev/null @@ -1,360 +0,0 @@ -!< WenOOF test: interpolation of polynomial functions. -module polynoms_int_test_module -!< Auxiliary module defining the test class. - -use flap, only : command_line_interface -#ifdef r16p -use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz -#else -use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz -#endif -use pyplot_module, only : pyplot -use wenoof, only : interpolator_object, wenoof_create -use wenoof_test_ui, only : test_ui - -implicit none -private -public :: test - -real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. - -type :: solution_data - !< Class to handle solution data. - real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. - real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. - real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. - real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. - real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. - real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: error_L2(:) !< L2 norm of the numerical error. - real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). -endtype solution_data - -type :: test - !< Class to handle test(s). - !< - !< Test is driven by the Command Line Interface (CLI) options. - !< - !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. - private - type(test_ui) :: ui !< Command line interface handler. - type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. - real(RPP), allocatable :: accuracy(:,:,:) !< Accuracy (measured) [1:2, 1:pn_number-1, 1:S_number]. - contains - ! public methods - procedure, pass(self) :: execute !< Execute selected test(s). - ! private methods - procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. - procedure, pass(self), private :: analize_errors !< Analize errors. - procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. - procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. - procedure, pass(self), private :: perform !< Perform test(s). - procedure, pass(self), private :: save_results_and_plots !< Save results and plots. -endtype test - -contains - ! public methods - subroutine execute(self) - !< Execute test(s). - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - - call self%ui%get - if (trim(adjustl(self%ui%interpolator_type))/='all') then - call self%perform - else - do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) - call self%perform - enddo - endif - endsubroutine execute - - ! private methods - subroutine allocate_solution_data(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - - call self%deallocate_solution_data - allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) - if (self%ui%pn_number>1) then - allocate(self%accuracy(1:2, 1:self%ui%pn_number, 1:self%ui%S_number)) - self%accuracy = 0._RPP - endif - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - allocate(self%solution(pn, s)%error_L2( 1:2 )) - self%solution(pn, s)%x_cell = 0._RPP - self%solution(pn, s)%fx_cell = 0._RPP - self%solution(pn, s)%x_face = 0._RPP - self%solution(pn, s)%fx_face = 0._RPP - self%solution(pn, s)%interpolations = 0._RPP - self%solution(pn, s)%si = 0._RPP - self%solution(pn, s)%weights = 0._RPP - self%solution(pn, s)%error_L2 = 0._RPP - enddo - enddo - endsubroutine allocate_solution_data - - subroutine compute_reference_solution(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%allocate_solution_data - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - self%solution(pn, s)%Dx = 1._RPP / self%ui%points_number(pn) - ! compute the values used for the interpolation of polynomials function: cell values - do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) - self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) - enddo - ! values to which the interpolation should tend - do i = 1, self%ui%points_number(pn) - self%solution(pn, s)%x_face( 1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%x_face( 2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%ui%S(s)+2) - self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%ui%S(s)+2) - enddo - enddo - enddo - endsubroutine compute_reference_solution - - subroutine deallocate_solution_data(self) - !< Deallocate solution data. - class(test), intent(inout) :: self !< Test. - - if (allocated(self%solution)) deallocate(self%solution) - if (allocated(self%accuracy)) deallocate(self%accuracy) - endsubroutine deallocate_solution_data - - subroutine perform(self) - !< Perform the test. - class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. - class(interpolator_object), allocatable :: interpolator !< WENO interpolator. - real(RPP), allocatable :: stencil(:,:) !< Stencils used. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%compute_reference_solution - do s=1, self%ui%S_number - call wenoof_create(interpolator_type='interpolator-'//trim(adjustl(self%ui%interpolator_type)), & - S=self%ui%S(s), & - interpolator=interpolator, & - eps=self%ui%eps) - if (self%ui%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) - do pn=1, self%ui%pn_number - do i=1, self%ui%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) - enddo - enddo - deallocate(stencil) - enddo - call self%analize_errors - call self%save_results_and_plots - endsubroutine perform - - subroutine save_results_and_plots(self) - !< Save results and plots. - class(test), intent(inout) :: self !< Test. - type(pyplot) :: plt !< Plot handler. - character(len=:), allocatable :: buffer !< Buffer string. - character(len=:), allocatable :: output_dir !< Output directory. - character(len=:), allocatable :: file_bname !< File base name. - integer(I_P) :: file_unit !< File unit. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: ss !< Counter. - integer(I_P) :: f !< Counter. - - output_dir = trim(adjustl(self%ui%output_dir))//'/' - if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-'//trim(adjustl(self%ui%interpolator_type)) - - if (self%ui%results) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') - buffer = 'VARIABLES = "x" "f(x)" "x_left" "x_right" "f(x)_left" "f(x)_right"' - buffer = buffer//' "interpolation_left" "interpolation_right"' - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' - enddo - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' - enddo - write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' - associate(x_cell => self%solution(pn, s)%x_cell, & - fx_cell => self%solution(pn, s)%fx_cell, & - x_face => self%solution(pn, s)%x_face, & - fx_face => self%solution(pn, s)%fx_face, & - interpolations => self%solution(pn, s)%interpolations, & - si => self%solution(pn, s)%si, & - weights => self%solution(pn, s)%weights, & - Dx => self%solution(pn, s)%Dx) - do i = 1, self%ui%points_number(pn) - write(file_unit, "("//trim(str(8+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (interpolations(f,i), f=1, 2), & - ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) - enddo - endassociate - close(file_unit) - enddo - enddo - - if (self%ui%errors_analysis.and.self%ui%pn_number>1) then - open(newunit=file_unit, file=file_bname//'-accuracy.dat') - write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2) L" "error (L2) R" "obs order L" "obs order R" "formal order"' - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & - self%ui%points_number(pn), & - (self%solution(pn, s)%error_L2(f), f=1, 2), & - (self%accuracy(f, pn, s), f=1, 2), & - 2*self%ui%S(s)-1 - enddo - enddo - close(file_unit) - endif - endif - -#ifndef r16p - ! pyplot fortran does not support 128 bit reals - if (self%plots) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - buffer = 'WENO interpolation of polynomial function; '//& - 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) - call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%dfx_cell(:), & - label='polynom', & - linestyle='k-', & - linewidth=2, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_face(1,1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%interpolations(1,:), & - label='WENO interpolation left', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_face(2,1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%interpolations(2,:), & - label='WENO interpolation right', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%savefig(file_bname//& - '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') - enddo - enddo - endif -#endif - endsubroutine save_results_and_plots - - subroutine analize_errors(self) - !< Analize errors. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: f !< Counter. - - if (self%ui%errors_analysis) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - associate(error_L2=>self%solution(pn, s)%error_L2, & - Dx=>self%solution(pn, s)%Dx, & - fx_face=>self%solution(pn, s)%fx_face, & - interpolations=>self%solution(pn, s)%interpolations) - error_L2 = 0._RPP - do i=1, self%ui%points_number(pn) - do f=1,2 - error_L2(f) = error_L2(f) + (interpolations(f,i) - fx_face(f,i))**2 - enddo - enddo - error_L2 = sqrt(error_L2) - endassociate - enddo - enddo - if (self%ui%pn_number>1) then - do s=1, self%ui%S_number - do pn=2, self%ui%pn_number - do f=1,2 - self%accuracy(f, pn, s) = log(self%solution(pn - 1, s)%error_L2(f) / self%solution(pn, s)%error_L2(f)) / & - log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) - enddo - enddo - enddo - endif - endif - endsubroutine analize_errors - - ! non TBP - pure function interface_function(x, o) result(y) - !< Interface function. - real(RPP), intent(in) :: x !< X value. - integer(I_P), intent(in) :: o !< Polynomial order. - real(RPP) :: y !< Y value. - integer(I_P) :: i !< Counter. - - y = 0._RPP - do i=1, o - y = y + i * (x ** i) - enddo - endfunction interface_function - - pure function dinterface_function_dx(x, o) result(y) - !< Derivative of interface function. - real(RPP), intent(in) :: x !< X value. - integer(I_P), intent(in) :: o !< Polynomial order. - real(RPP) :: y !< Y value. - integer(I_P) :: i !< Counter. - - y = 0._RPP - do i=1, o - y = y + i * i * (x ** (i - 1)) - enddo - endfunction dinterface_function_dx -endmodule polynoms_int_test_module - -program polynoms_interpolation -!< WenOOF test: interpolation of polynomial functions. - -use polynoms_int_test_module - -implicit none -type(test) :: poly_test - -call poly_test%execute -endprogram polynoms_interpolation diff --git a/src/tests/polynoms_reconstruction.f90 b/src/tests/polynoms_reconstruction.f90 deleted file mode 100644 index 5920ff1..0000000 --- a/src/tests/polynoms_reconstruction.f90 +++ /dev/null @@ -1,357 +0,0 @@ -!< WenOOF test: reconstruction of polynomial functions. -module polynoms_rec_test_module -!< Auxiliary module defining the test class. - -use flap, only : command_line_interface -#ifdef r16p -use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz -#else -use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz -#endif -use pyplot_module, only : pyplot -use wenoof, only : interpolator_object, wenoof_create -use wenoof_test_ui, only : test_ui - -implicit none -private -public :: test -real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. - -type :: solution_data - !< Class to handle solution data. - real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. - real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. - real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. - real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. - real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. - real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. - real(RPP), allocatable :: reconstruction(:,:) !< Reconstruction values [1:2,1:points_number]. - real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. - real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). - real(RPP) :: error_L2=0._RPP !< L2 norm of the numerical error. -endtype solution_data - -type :: test - !< Class to handle test(s). - !< - !< Test is driven by the Command Line Interface (CLI) options. - !< - !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. - private - type(test_ui) :: ui !< Command line interface handler. - type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. - real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. - contains - ! public methods - procedure, pass(self) :: execute !< Execute selected test(s). - ! private methods - procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. - procedure, pass(self), private :: analize_errors !< Analize errors. - procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. - procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. - procedure, pass(self), private :: perform !< Perform test(s). - procedure, pass(self), private :: save_results_and_plots !< Save results and plots. -endtype test - -contains - ! public methods - subroutine execute(self) - !< Execute test(s). - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - - call self%ui%get - if (trim(adjustl(self%ui%interpolator_type))/='all') then - call self%perform - else - do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) - call self%perform - enddo - endif - endsubroutine execute - - ! private methods - subroutine allocate_solution_data(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - - call self%deallocate_solution_data - allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) - if (self%ui%pn_number>1) then - allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) - self%accuracy = 0._RPP - endif - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%reconstruction(1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - self%solution(pn, s)%x_cell = 0._RPP - self%solution(pn, s)%fx_cell = 0._RPP - self%solution(pn, s)%x_face = 0._RPP - self%solution(pn, s)%fx_face = 0._RPP - self%solution(pn, s)%dfx_cell = 0._RPP - self%solution(pn, s)%interpolations = 0._RPP - self%solution(pn, s)%reconstruction = 0._RPP - self%solution(pn, s)%si = 0._RPP - self%solution(pn, s)%weights = 0._RPP - enddo - enddo - endsubroutine allocate_solution_data - - subroutine compute_reference_solution(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%allocate_solution_data - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - self%solution(pn, s)%Dx = 1._RPP / self%ui%points_number(pn) - ! compute the values used for the interpolation/reconstruction of polynomials function: cell values - do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) - self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) - enddo - ! values to which the interpolation/reconstruction should tend - do i = 1, self%ui%points_number(pn) - self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%ui%S(s)+2) - self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%ui%S(s)+2) - self%solution(pn, s)%dfx_cell(i) = dinterface_function_dx(self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) - enddo - enddo - enddo - endsubroutine compute_reference_solution - - subroutine deallocate_solution_data(self) - !< Deallocate solution data. - class(test), intent(inout) :: self !< Test. - - if (allocated(self%solution)) deallocate(self%solution) - if (allocated(self%accuracy)) deallocate(self%accuracy) - endsubroutine deallocate_solution_data - - subroutine perform(self) - !< Perform the test. - class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. - class(interpolator_object), allocatable :: interpolator !< WENO interpolator. - real(RPP), allocatable :: stencil(:,:) !< Stencils used. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%compute_reference_solution - do s=1, self%ui%S_number - call wenoof_create(interpolator_type='reconstructor-'//trim(adjustl(self%ui%interpolator_type)), & - S=self%ui%S(s), & - interpolator=interpolator, & - eps=self%ui%eps) - if (self%ui%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) - do pn=1, self%ui%pn_number - do i=1, self%ui%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%reconstruction(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) - enddo - enddo - deallocate(stencil) - enddo - call self%analize_errors - call self%save_results_and_plots - endsubroutine perform - - subroutine save_results_and_plots(self) - !< Save results and plots. - class(test), intent(inout) :: self !< Test. - type(pyplot) :: plt !< Plot handler. - character(len=:), allocatable :: buffer !< Buffer string. - character(len=:), allocatable :: output_dir !< Output directory. - character(len=:), allocatable :: file_bname !< File base name. - integer(I_P) :: file_unit !< File unit. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: ss !< Counter. - integer(I_P) :: f !< Counter. - - output_dir = trim(adjustl(self%ui%output_dir))//'/' - if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-'//trim(adjustl(self%ui%interpolator_type)) - - if (self%ui%results) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') - buffer = 'VARIABLES = "x" "f(x)" "df_dx(x)" "x_left" "x_right" "f(x)_left" "f(x)_right"' - buffer = buffer//' "reconstruction_left" "reconstruction_right" "df_dx_reconstruction"' - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' - enddo - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' - enddo - write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' - associate(x_cell => self%solution(pn, s)%x_cell, & - fx_cell => self%solution(pn, s)%fx_cell, & - dfx_cell => self%solution(pn, s)%dfx_cell, & - x_face => self%solution(pn, s)%x_face, & - fx_face => self%solution(pn, s)%fx_face, & - reconstruction => self%solution(pn, s)%reconstruction, & - si => self%solution(pn, s)%si, & - weights => self%solution(pn, s)%weights, & - Dx => self%solution(pn, s)%Dx) - do i = 1, self%ui%points_number(pn) - write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - dfx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (reconstruction(f,i), f=1, 2), & - (reconstruction(2,i)-reconstruction(1,i))/Dx, & - ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) - enddo - endassociate - close(file_unit) - enddo - enddo - - if (self%ui%errors_analysis.and.self%ui%pn_number>1) then - open(newunit=file_unit, file=file_bname//'-accuracy.dat') - write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & - self%ui%points_number(pn), & - self%solution(pn, s)%error_L2, & - self%accuracy(pn, s), & - 2*self%ui%S(s)-1 - enddo - enddo - close(file_unit) - endif - endif - -#ifndef r16p - ! pyplot fortran does not support 128 bit reals - if (self%plots) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - buffer = 'WENO reconstruction of $d \sin(x)/Dx=\cos(x)$; '//& - 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) - call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%dfx_cell(:), & - label='$\sin(x)$', & - linestyle='k-', & - linewidth=2, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=(self%solution(pn, s)%reconstruction(2,:)-self%solution(pn, s)%reconstruction(1,:))/ & - self%solution(pn, s)%Dx, & - label='WENO reconstruction', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%savefig(file_bname//& - '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') - enddo - enddo - endif -#endif - endsubroutine save_results_and_plots - - subroutine analize_errors(self) - !< Analize errors. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - if (self%ui%errors_analysis) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - associate(error_L2=>self%solution(pn, s)%error_L2, & - Dx=>self%solution(pn, s)%Dx, & - dfx_cell=>self%solution(pn, s)%dfx_cell, & - reconstruction=>self%solution(pn, s)%reconstruction) - error_L2 = 0._RPP - do i=1, self%ui%points_number(pn) - error_L2 = error_L2 + ((reconstruction(2,i)-reconstruction(1,i))/Dx - dfx_cell(i))**2 - enddo - error_L2 = sqrt(error_L2) - endassociate - enddo - enddo - if (self%ui%pn_number>1) then - do s=1, self%ui%S_number - do pn=2, self%ui%pn_number - self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & - log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) - enddo - enddo - endif - endif - endsubroutine analize_errors - - ! non TBP - pure function interface_function(x, o) result(y) - !< Interface function. - real(RPP), intent(in) :: x !< X value. - integer(I_P), intent(in) :: o !< Polynomial order. - real(RPP) :: y !< Y value. - integer(I_P) :: i !< Counter. - - y = 0._RPP - do i=1, o - y = y + i * (x ** i) - enddo - endfunction interface_function - - pure function dinterface_function_dx(x, o) result(y) - !< Derivative of interface function. - real(RPP), intent(in) :: x !< X value. - integer(I_P), intent(in) :: o !< Polynomial order. - real(RPP) :: y !< Y value. - integer(I_P) :: i !< Counter. - - y = 0._RPP - do i=1, o - y = y + i * i * (x ** (i - 1)) - enddo - endfunction dinterface_function_dx -endmodule polynoms_rec_test_module - -program polynoms_reconstruction -!< WenOOF test: reconstruction of polynomial functions. - -use polynoms_rec_test_module - -implicit none -type(test) :: poly_test - -call poly_test%execute -endprogram polynoms_reconstruction diff --git a/src/tests/polynoms_test.f90 b/src/tests/polynoms_test.f90 new file mode 100644 index 0000000..19e40f1 --- /dev/null +++ b/src/tests/polynoms_test.f90 @@ -0,0 +1,537 @@ +!< WenOOF test: interpolation or reconstruction of polynomial functions. +module polynoms_test_module +!< Auxiliary module defining the test class. + +use flap, only : command_line_interface +#ifdef r16p +use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz +#else +use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz +#endif +use pyplot_module, only : pyplot +use wenoof, only : interpolator_object, wenoof_create +use wenoof_test_ui, only : test_ui + +implicit none +private +public :: test + +real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. + +type :: solution_data + !< Class to handle solution data. + real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. + real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. + real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. + real(RPP), allocatable :: x_int(:) !< Interpolation domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_int(:) !< Interpolation refecence values [1-S:points_number+S]. + real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. + real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. + real(RPP), allocatable :: reconstruction(:) !< Reconstruction values [1:2,1:points_number]. + real(RPP), allocatable :: si_r(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: weights_r(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: interpolation(:) !< Interpolated values [1:points_number]. + real(RPP), allocatable :: si_i(:,:) !< Computed smoothness indicators [1:points_number,0:S-1]. + real(RPP), allocatable :: weights_i(:,:) !< Computed weights [1:points_number,0:S-1]. + real(RPP) :: error_L2 !< L2 norm of the numerical error. + real(RPP) :: x_target !< Abscissa of the interpolation [-0.5:0.5]. + real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). +endtype solution_data + +type :: test + !< Class to handle test(s). + !< + !< Test is driven by the Command Line Interface (CLI) options. + !< + !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. + private + type(test_ui) :: ui !< Command line interface handler. + type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. + real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. + contains + ! public methods + procedure, pass(self) :: execute !< Execute selected test(s). + ! private methods + procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. + procedure, pass(self), private :: analize_errors !< Analize errors. + procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. + procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. + procedure, pass(self), private :: perform !< Perform test(s). + procedure, pass(self), private :: save_results_and_plots !< Save results and plots. +endtype test + +contains + ! public methods + subroutine execute(self) + !< Execute test(s). + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + + call self%ui%get + if (trim(adjustl(self%ui%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine execute + + ! private methods + subroutine allocate_solution_data(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + + call self%deallocate_solution_data + allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) + if (self%ui%pn_number>1) then + allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) + self%accuracy = 0._RPP + endif + if (self%ui%interpolate) then + self%solution%x_target = self%ui%x_target + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_int( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_int( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%interpolation( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si_i( 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights_i( 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_int = 0._RPP + self%solution(pn, s)%fx_int = 0._RPP + self%solution(pn, s)%interpolation = 0._RPP + self%solution(pn, s)%si_i = 0._RPP + self%solution(pn, s)%weights_i = 0._RPP + self%solution(pn, s)%error_L2 = 0._RPP + enddo + enddo + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%reconstruction( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si_r( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights_r( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_face = 0._RPP + self%solution(pn, s)%fx_face = 0._RPP + self%solution(pn, s)%dfx_cell = 0._RPP + self%solution(pn, s)%interpolations = 0._RPP + self%solution(pn, s)%reconstruction = 0._RPP + self%solution(pn, s)%si_r = 0._RPP + self%solution(pn, s)%weights_r = 0._RPP + self%solution(pn, s)%error_L2 = 0._RPP + enddo + enddo + endif + endsubroutine allocate_solution_data + + subroutine compute_reference_solution(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%allocate_solution_data + if (self%ui%interpolate) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 1._RPP / self%ui%points_number(pn) + ! compute the values used for the interpolation of polynomials function: cell values + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) + enddo + ! values to which the interpolation should tend + do i = 1, self%ui%points_number(pn) + self%solution(pn, s)%x_int(i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%x_target * self%solution(pn, s)%Dx + self%solution(pn, s)%fx_int(i) = interface_function(self%solution(pn, s)%x_int(i), o=2*self%ui%S(s)+2) + enddo + enddo + enddo + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 1._RPP / self%ui%points_number(pn) + ! compute the values used for the interpolation/reconstruction of polynomials function: cell values + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = interface_function(x=self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) + enddo + ! values to which the interpolation/reconstruction should tend + do i = 1, self%ui%points_number(pn) + self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_face(1,i) = interface_function(self%solution(pn, s)%x_face(1,i), o=2*self%ui%S(s)+2) + self%solution(pn, s)%fx_face(2,i) = interface_function(self%solution(pn, s)%x_face(2,i), o=2*self%ui%S(s)+2) + self%solution(pn, s)%dfx_cell(i) = dinterface_function_dx(self%solution(pn, s)%x_cell(i), o=2*self%ui%S(s)+2) + enddo + enddo + enddo + endif + endsubroutine compute_reference_solution + + subroutine deallocate_solution_data(self) + !< Deallocate solution data. + class(test), intent(inout) :: self !< Test. + + if (allocated(self%solution)) deallocate(self%solution) + if (allocated(self%accuracy)) deallocate(self%accuracy) + endsubroutine deallocate_solution_data + + subroutine perform(self) + !< Perform the test. + class(test), intent(inout) :: self !< Test. + real(RPP), allocatable :: error(:) !< Error (norm L2) with respect the exact solution. + real(RPP), allocatable :: order(:) !< Observed order based on subsequent refined solutions. + class(interpolator_object), allocatable :: interpolator !< WENO interpolator. + real(RPP), allocatable :: stencil_i(:) !< Stencils used for interpolation. + real(RPP), allocatable :: stencil_r(:,:) !< Stencils used for reconstruction. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%compute_reference_solution + if (self%ui%interpolate) then + do s=1, self%ui%S_number + call wenoof_create(interpolator_type='interpolator-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + x_target=0.3_RPP, & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil_i(1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil_i(:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + call interpolator%interpolate(stencil=stencil_i, & + interpolation=self%solution(pn, s)%interpolation(i), & + si=self%solution(pn, s)%si_i(i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights_i(i, 0:self%ui%S(s)-1)) + enddo + enddo + deallocate(stencil_i) + enddo + else + do s=1, self%ui%S_number + call wenoof_create(interpolator_type='reconstructor-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil_r(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil_r(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + stencil_r(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + call interpolator%interpolate(stencil=stencil_r, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si_r(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights_r(:, i, 0:self%ui%S(s)-1)) + self%solution(pn, s)%reconstruction(i) = & + (self%solution(pn, s)%interpolations(2,i) - self%solution(pn, s)%interpolations(1,i))/self%solution(pn, s)%Dx + enddo + enddo + deallocate(stencil_r) + enddo + endif + call self%analize_errors + call self%save_results_and_plots + endsubroutine perform + + subroutine save_results_and_plots(self) + !< Save results and plots. + class(test), intent(inout) :: self !< Test. + type(pyplot) :: plt !< Plot handler. + character(len=:), allocatable :: buffer !< Buffer string. + character(len=:), allocatable :: output_dir !< Output directory. + character(len=:), allocatable :: file_bname !< File base name. + integer(I_P) :: file_unit !< File unit. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + integer(I_P) :: ss !< Counter. + integer(I_P) :: f !< Counter. + + output_dir = trim(adjustl(self%ui%output_dir))//'/' + if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) + + if (self%ui%interpolate) then + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-interpolator-'//trim(adjustl(self%ui%interpolator_type)) + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "f(x)" "x_int" "f(x)_int" "interpolation"' + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.)) + enddo + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.)) + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + x_int => self%solution(pn, s)%x_int, & + fx_int => self%solution(pn, s)%fx_int, & + interpolation => self%solution(pn, s)%interpolation, & + si => self%solution(pn, s)%si_i, & + weights => self%solution(pn, s)%weights_i, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(5+2*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + x_int(i), & + fx_int(i), & + interpolation(i), & + (si(i, ss), ss=0, self%ui%S(s)-1), & + (weights(i, ss), ss=0, self%ui%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + self%solution(pn, s)%error_L2, & + self%accuracy(pn, s), & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + else + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-reconstructor-'//trim(adjustl(self%ui%interpolator_type)) + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "f(x)" "df_dx(x)" "x_left" "x_right" "f(x)_left" "f(x)_right"' + buffer = buffer//' "reconstruction_left" "reconstruction_right" "df_dx_reconstruction"' + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' + enddo + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + dfx_cell => self%solution(pn, s)%dfx_cell, & + x_face => self%solution(pn, s)%x_face, & + fx_face => self%solution(pn, s)%fx_face, & + interpolations => self%solution(pn, s)%interpolations, & + reconstruction => self%solution(pn, s)%reconstruction, & + si => self%solution(pn, s)%si_r, & + weights => self%solution(pn, s)%weights_r, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + dfx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (interpolations(f,i), f=1, 2), & + reconstruction(i), & + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + self%solution(pn, s)%error_L2, & + self%accuracy(pn, s), & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + endif + +#ifndef r16p + ! pyplot fortran does not support 128 bit reals + if (self%ui%plots) then + if (self%ui%interpolate) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + buffer = 'WENO interpolation of polynomial function; '//& + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='x (m)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%fx_cell(:), & + label='polynom', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_int(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%interpolations(:), & + label='WENO interpolation', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') + enddo + enddo + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + buffer = 'WENO reconstruction of $d \p(x)/Dx; '//& + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='x (m)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%dfx_cell(:), & + label='dp', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%reconstruction(:), & + label='WENO reconstruction', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') + enddo + enddo + endif + endif +#endif + endsubroutine save_results_and_plots + + subroutine analize_errors(self) + !< Analize errors. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + if (self%ui%errors_analysis) then + if (self%ui%interpolate) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + fx_int=>self%solution(pn, s)%fx_int, & + interpolation=>self%solution(pn, s)%interpolation) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + error_L2 = error_L2 + (interpolation(i) - fx_int(i))**2 + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + endif + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + dfx_cell=>self%solution(pn, s)%dfx_cell, & + reconstruction=>self%solution(pn, s)%reconstruction) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + error_L2 = error_L2 + (reconstruction(i) - dfx_cell(i))**2 + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + endif + endif + endif + endsubroutine analize_errors + + ! non TBP + pure function interface_function(x, o) result(y) + !< Interface function. + real(RPP), intent(in) :: x !< X value. + integer(I_P), intent(in) :: o !< Polynomial order. + real(RPP) :: y !< Y value. + integer(I_P) :: i !< Counter. + + y = 0._RPP + do i=1, o + y = y + i * (x ** i) + enddo + endfunction interface_function + + pure function dinterface_function_dx(x, o) result(y) + !< Derivative of interface function. + real(RPP), intent(in) :: x !< X value. + integer(I_P), intent(in) :: o !< Polynomial order. + real(RPP) :: y !< Y value. + integer(I_P) :: i !< Counter. + + y = 0._RPP + do i=1, o + y = y + i * i * (x ** (i - 1)) + enddo + endfunction dinterface_function_dx +endmodule polynoms_test_module + +program polynoms_test_program +!< WenOOF test: interpolation of polynomial functions. + +use polynoms_test_module + +implicit none +type(test) :: polynoms_test + +call polynoms_test%execute +endprogram polynoms_test_program diff --git a/src/tests/sin_interpolation.f90 b/src/tests/sin_interpolation.f90 deleted file mode 100644 index 9e1c519..0000000 --- a/src/tests/sin_interpolation.f90 +++ /dev/null @@ -1,333 +0,0 @@ -!< WenOOF test: interpolation of sine function. -module sin_test_module -!< Auxiliary module defining the test class. - -use flap, only : command_line_interface -#ifdef r16p -use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz -#else -use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz -#endif -use pyplot_module, only : pyplot -use wenoof, only : interpolator_object, wenoof_create -use wenoof_test_ui, only : test_ui - -implicit none -private -public :: test - -real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. - -type :: solution_data - !< Class to handle solution data. - real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. - real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. - real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. - real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. - real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. - real(RPP), allocatable :: si(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: weights(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. - real(RPP), allocatable :: error_L2(:) !< L2 norm of the numerical error [1:2]. - real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). -endtype solution_data - -type :: test - !< Class to handle test(s). - !< - !< Test is driven by the Command Line Interface (CLI) options. - !< - !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. - private - type(test_ui) :: ui !< Command line interface handler. - type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. - real(RPP), allocatable :: accuracy(:,:,:) !< Accuracy (measured) [1:2, 1:pn_number-1, 1:S_number]. - contains - ! public methods - procedure, pass(self) :: execute !< Execute selected test(s). - ! private methods - procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. - procedure, pass(self), private :: analize_errors !< Analize errors. - procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. - procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. - procedure, pass(self), private :: perform !< Perform test(s). - procedure, pass(self), private :: save_results_and_plots !< Save results and plots. -endtype test - -contains - ! public methods - subroutine execute(self) - !< Execute test(s). - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - - call self%ui%get - if (trim(adjustl(self%ui%interpolator_type))/='all') then - call self%perform - else - do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) - call self%perform - enddo - endif - endsubroutine execute - - ! private methods - subroutine allocate_solution_data(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - - call self%deallocate_solution_data - allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) - if (self%ui%pn_number>1) then - allocate(self%accuracy(1:2, 1:self%ui%pn_number, 1:self%ui%S_number)) - self%accuracy = 0._RPP - endif - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) - allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) - allocate(self%solution(pn, s)%si( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - allocate(self%solution(pn, s)%weights( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) - allocate(self%solution(pn, s)%error_L2( 1:2 )) - self%solution(pn, s)%x_cell = 0._RPP - self%solution(pn, s)%fx_cell = 0._RPP - self%solution(pn, s)%x_face = 0._RPP - self%solution(pn, s)%fx_face = 0._RPP - self%solution(pn, s)%interpolations = 0._RPP - self%solution(pn, s)%si = 0._RPP - self%solution(pn, s)%weights = 0._RPP - self%solution(pn, s)%error_L2 = 0._RPP - enddo - enddo - endsubroutine allocate_solution_data - - subroutine compute_reference_solution(self) - !< Allocate solution data. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%allocate_solution_data - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - self%solution(pn, s)%Dx = 2 * pi / self%ui%points_number(pn) - ! compute the values used for the interpolation of sin function: cell values - do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) - self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) - enddo - ! values to which the interpolation should tend - do i = 1, self%ui%points_number(pn) - self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP - self%solution(pn, s)%fx_face(1,i) = sin(self%solution(pn, s)%x_face(1,i)) - self%solution(pn, s)%fx_face(2,i) = sin(self%solution(pn, s)%x_face(2,i)) - enddo - enddo - enddo - endsubroutine compute_reference_solution - - subroutine deallocate_solution_data(self) - !< Deallocate solution data. - class(test), intent(inout) :: self !< Test. - - if (allocated(self%solution)) deallocate(self%solution) - if (allocated(self%accuracy)) deallocate(self%accuracy) - endsubroutine deallocate_solution_data - - subroutine perform(self) - !< Perform the test. - class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:,:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:,:) !< Observed order based on subsequent refined solutions. - class(interpolator_object), allocatable :: interpolator !< WENO interpolator. - real(RPP), allocatable :: stencil(:,:) !< Stencils used. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - - call self%compute_reference_solution - do s=1, self%ui%S_number - call wenoof_create(interpolator_type='interpolator-'//trim(adjustl(self%ui%interpolator_type)), & - S=self%ui%S(s), & - interpolator=interpolator, & - eps=self%ui%eps) - if (self%ui%verbose) print '(A)', interpolator%description() - allocate(stencil(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) - do pn=1, self%ui%pn_number - do i=1, self%ui%points_number(pn) - stencil(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - stencil(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil, & - interpolation=self%solution(pn, s)%interpolations(:,i), & - si=self%solution(pn, s)%si(:, i, 0:self%ui%S(s)-1), & - weights=self%solution(pn, s)%weights(:, i, 0:self%ui%S(s)-1)) - enddo - enddo - deallocate(stencil) - enddo - call self%analize_errors - call self%save_results_and_plots - endsubroutine perform - - subroutine save_results_and_plots(self) - !< Save results and plots. - class(test), intent(inout) :: self !< Test. - type(pyplot) :: plt !< Plot handler. - character(len=:), allocatable :: buffer !< Buffer string. - character(len=:), allocatable :: output_dir !< Output directory. - character(len=:), allocatable :: file_bname !< File base name. - integer(I_P) :: file_unit !< File unit. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: ss !< Counter. - integer(I_P) :: f !< Counter. - - output_dir = trim(adjustl(self%ui%output_dir))//'/' - if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) - file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-interpolator-'//trim(adjustl(self%ui%interpolator_type)) - - if (self%ui%results) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') - buffer = 'VARIABLES = "x" "sin(x)" "x_left" "x_right" "sin(x)_left" "sin(x)_right"' - buffer = buffer//' "interpolation_left" "interpolation_right"' - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' - enddo - do ss=0, self%ui%S(s)-1 - buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' - enddo - write(file_unit, "(A)") buffer - write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& - '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' - associate(x_cell => self%solution(pn, s)%x_cell, & - fx_cell => self%solution(pn, s)%fx_cell, & - x_face => self%solution(pn, s)%x_face, & - fx_face => self%solution(pn, s)%fx_face, & - interpolations => self%solution(pn, s)%interpolations, & - si => self%solution(pn, s)%si, & - weights => self%solution(pn, s)%weights, & - Dx => self%solution(pn, s)%Dx) - do i = 1, self%ui%points_number(pn) - write(file_unit, "("//trim(str(8+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & - x_cell(i), & - fx_cell(i), & - (x_face(f,i), f=1, 2), & - (fx_face(f,i), f=1, 2), & - (interpolations(f,i), f=1, 2), & - ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & - ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) - enddo - endassociate - close(file_unit) - enddo - enddo - - if (self%ui%errors_analysis.and.self%ui%pn_number>1) then - open(newunit=file_unit, file=file_bname//'-accuracy.dat') - write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2) L" "error (L2) R" "obs order L" "obs order R" "formal order"' - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - write(file_unit, "(2(I5,1X),"//FRPP//",1X,"//FRPP//",1X,F5.2,1X,F5.2,1X,I3)") self%ui%S(s), & - self%ui%points_number(pn), & - (self%solution(pn, s)%error_L2(f), f=1, 2), & - (self%accuracy(f, pn, s), f=1, 2), & - 2*self%ui%S(s)-1 - enddo - enddo - close(file_unit) - endif - endif - -#ifndef r16p - ! pyplot fortran does not support 128 bit reals - if (self%ui%plots) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - buffer = 'WENO interpolation of $\sin(x)$; '//& - 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) - call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) - call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%fx_cell(:), & - label='$\sin(x)$', & - linestyle='k-', & - linewidth=2, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_face(1,1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%interpolations(1,:), & - label='WENO interpolation left', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%add_plot(x=self%solution(pn, s)%x_face(2,1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%interpolations(2,:), & - label='WENO interpolation right', & - linestyle='ro', & - markersize=6, & - ylim=[-1.1_RPP, 1.1_RPP]) - call plt%savefig(file_bname//& - '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') - enddo - enddo - endif -#endif - endsubroutine save_results_and_plots - - subroutine analize_errors(self) - !< Analize errors. - class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. - integer(I_P) :: pn !< Counter. - integer(I_P) :: i !< Counter. - integer(I_P) :: f !< Counter. - - if (self%ui%errors_analysis) then - do s=1, self%ui%S_number - do pn=1, self%ui%pn_number - associate(error_L2=>self%solution(pn, s)%error_L2, & - Dx=>self%solution(pn, s)%Dx, & - fx_face=>self%solution(pn, s)%fx_face, & - interpolations=>self%solution(pn, s)%interpolations) - error_L2 = 0._RPP - do i=1, self%ui%points_number(pn) - do f=1,2 - error_L2(f) = error_L2(f) + (interpolations(f,i) - fx_face(f,i))**2 - enddo - enddo - error_L2 = sqrt(error_L2) - endassociate - enddo - enddo - if (self%ui%pn_number>1) then - do s=1, self%ui%S_number - do pn=2, self%ui%pn_number - do f=1,2 - self%accuracy(f, pn, s) = log(self%solution(pn - 1, s)%error_L2(f) / self%solution(pn, s)%error_L2(f)) / & - log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) - enddo - enddo - enddo - endif - endif - endsubroutine analize_errors -endmodule sin_test_module - -program sin_interpolation -!< WenOOF test: interpolation of sine function. - -use sin_test_module - -implicit none -type(test) :: sin_test - -call sin_test%execute -endprogram sin_interpolation diff --git a/src/tests/sin_test.f90 b/src/tests/sin_test.f90 new file mode 100644 index 0000000..fc49ed4 --- /dev/null +++ b/src/tests/sin_test.f90 @@ -0,0 +1,509 @@ +!< WenOOF test: interpolation or reconstruction of sine function. +module sin_test_module +!< Auxiliary module defining the test class. + +use flap, only : command_line_interface +#ifdef r16p +use penf, only: I_P, RPP=>R16P, FRPP=>FR16P, str, strz +#else +use penf, only: I_P, RPP=>R8P, FRPP=>FR8P, str, strz +#endif +use pyplot_module, only : pyplot +use wenoof, only : interpolator_object, wenoof_create +use wenoof_test_ui, only : test_ui + +implicit none +private +public :: test + +real(RPP), parameter :: pi = 4._RPP * atan(1._RPP) !< Pi greek. + +type :: solution_data + !< Class to handle solution data. + real(RPP), allocatable :: x_cell(:) !< Cell domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_cell(:) !< Cell refecence values [1-S:points_number+S]. + real(RPP), allocatable :: x_face(:,:) !< Face domain [1:2,1:points_number]. + real(RPP), allocatable :: fx_face(:,:) !< Face reference values [1:2,1:points_number]. + real(RPP), allocatable :: x_int(:) !< Interpolation domain [1-S:points_number+S]. + real(RPP), allocatable :: fx_int(:) !< Interpolation refecence values [1-S:points_number+S]. + real(RPP), allocatable :: dfx_cell(:) !< Cell refecence values of df/dx [1:points_number]. + real(RPP), allocatable :: interpolations(:,:) !< Interpolated values [1:2,1:points_number]. + real(RPP), allocatable :: reconstruction(:) !< Reconstruction values [1:2,1:points_number]. + real(RPP), allocatable :: si_r(:,:,:) !< Computed smoothness indicators [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: weights_r(:,:,:) !< Computed weights [1:2,1:points_number,0:S-1]. + real(RPP), allocatable :: interpolation(:) !< Interpolated values [1:points_number]. + real(RPP), allocatable :: si_i(:,:) !< Computed smoothness indicators [1:points_number,0:S-1]. + real(RPP), allocatable :: weights_i(:,:) !< Computed weights [1:points_number,0:S-1]. + real(RPP) :: error_L2 !< L2 norm of the numerical error. + real(RPP) :: x_target !< Abscissa of the interpolation [-0.5:0.5]. + real(RPP) :: Dx=0._RPP !< Space step (spatial resolution). +endtype solution_data + +type :: test + !< Class to handle test(s). + !< + !< Test is driven by the Command Line Interface (CLI) options. + !< + !< Test has only 1 public method `execute`: it executes test(s) accordingly to cli options. + private + type(test_ui) :: ui !< Command line interface handler. + type(solution_data), allocatable :: solution(:,:) !< Solution [1:pn_number, 1:S_number]. + real(RPP), allocatable :: accuracy(:,:) !< Accuracy (measured) [1:pn_number-1, 1:S_number]. + contains + ! public methods + procedure, pass(self) :: execute !< Execute selected test(s). + ! private methods + procedure, pass(self), private :: allocate_solution_data !< Allocate solution data. + procedure, pass(self), private :: analize_errors !< Analize errors. + procedure, pass(self), private :: compute_reference_solution !< Compute reference solution. + procedure, pass(self), private :: deallocate_solution_data !< Deallocate solution data. + procedure, pass(self), private :: perform !< Perform test(s). + procedure, pass(self), private :: save_results_and_plots !< Save results and plots. +endtype test + +contains + ! public methods + subroutine execute(self) + !< Execute test(s). + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + + call self%ui%get + if (trim(adjustl(self%ui%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine execute + + ! private methods + subroutine allocate_solution_data(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + + call self%deallocate_solution_data + allocate(self%solution(1:self%ui%pn_number, 1:self%ui%S_number)) + if (self%ui%pn_number>1) then + allocate(self%accuracy(1:self%ui%pn_number, 1:self%ui%S_number)) + self%accuracy = 0._RPP + endif + if (self%ui%interpolate) then + self%solution%x_target = self%ui%x_target + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_int( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_int( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%interpolation( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si_i( 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights_i( 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_int = 0._RPP + self%solution(pn, s)%fx_int = 0._RPP + self%solution(pn, s)%interpolation = 0._RPP + self%solution(pn, s)%si_i = 0._RPP + self%solution(pn, s)%weights_i = 0._RPP + self%solution(pn, s)%error_L2 = 0._RPP + enddo + enddo + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + allocate(self%solution(pn, s)%x_cell( 1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%fx_cell(1-self%ui%S(s):self%ui%points_number(pn)+self%ui%S(s) )) + allocate(self%solution(pn, s)%x_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%fx_face( 1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%dfx_cell( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%interpolations(1:2, 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%reconstruction( 1:self%ui%points_number(pn) )) + allocate(self%solution(pn, s)%si_r( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + allocate(self%solution(pn, s)%weights_r( 1:2, 1:self%ui%points_number(pn), 0:self%ui%S(s)-1)) + self%solution(pn, s)%x_cell = 0._RPP + self%solution(pn, s)%fx_cell = 0._RPP + self%solution(pn, s)%x_face = 0._RPP + self%solution(pn, s)%fx_face = 0._RPP + self%solution(pn, s)%dfx_cell = 0._RPP + self%solution(pn, s)%interpolations = 0._RPP + self%solution(pn, s)%reconstruction = 0._RPP + self%solution(pn, s)%si_r = 0._RPP + self%solution(pn, s)%weights_r = 0._RPP + self%solution(pn, s)%error_L2 = 0._RPP + enddo + enddo + endif + endsubroutine allocate_solution_data + + subroutine compute_reference_solution(self) + !< Allocate solution data. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%allocate_solution_data + if (self%ui%interpolate) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 2 * pi / self%ui%points_number(pn) + ! compute the values used for the interpolation of sin function: cell values + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) + enddo + ! values to which the interpolation should tend + do i = 1, self%ui%points_number(pn) + self%solution(pn, s)%x_int(i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%x_target * self%solution(pn, s)%Dx + self%solution(pn, s)%fx_int(i) = sin(self%solution(pn, s)%x_int(i)) + enddo + enddo + enddo + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + self%solution(pn, s)%Dx = 2 * pi / self%ui%points_number(pn) + ! compute the values used for the interpolation/reconstruction of cos function: cell values + do i=1 - self%ui%S(s), self%ui%points_number(pn) + self%ui%S(s) + self%solution(pn, s)%x_cell(i) = i * self%solution(pn, s)%Dx - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_cell(i) = sin(self%solution(pn, s)%x_cell(i)) + enddo + ! values to which the interpolation/reconstruction should tend + do i = 1, self%ui%points_number(pn) + self%solution(pn, s)%x_face(1,i) = self%solution(pn, s)%x_cell(i) - self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%x_face(2,i) = self%solution(pn, s)%x_cell(i) + self%solution(pn, s)%Dx / 2._RPP + self%solution(pn, s)%fx_face(1,i) = sin(self%solution(pn, s)%x_face(1,i)) + self%solution(pn, s)%fx_face(2,i) = sin(self%solution(pn, s)%x_face(2,i)) + self%solution(pn, s)%dfx_cell(i) = cos(self%solution(pn, s)%x_cell(i)) + enddo + enddo + enddo + endif + endsubroutine compute_reference_solution + + subroutine deallocate_solution_data(self) + !< Deallocate solution data. + class(test), intent(inout) :: self !< Test. + + if (allocated(self%solution)) deallocate(self%solution) + if (allocated(self%accuracy)) deallocate(self%accuracy) + endsubroutine deallocate_solution_data + + subroutine perform(self) + !< Perform the test. + class(test), intent(inout) :: self !< Test. + real(RPP), allocatable :: error(:) !< Error (norm L2) with respect the exact solution. + real(RPP), allocatable :: order(:) !< Observed order based on subsequent refined solutions. + class(interpolator_object), allocatable :: interpolator !< WENO interpolator. + real(RPP), allocatable :: stencil_i(:) !< Stencils used for interpolation. + real(RPP), allocatable :: stencil_r(:,:) !< Stencils used for reconstruction. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + call self%compute_reference_solution + if (self%ui%interpolate) then + do s=1, self%ui%S_number + call wenoof_create(interpolator_type='interpolator-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + x_target=self%ui%x_target, & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil_i(1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil_i(:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + call interpolator%interpolate(stencil=stencil_i, & + interpolation=self%solution(pn, s)%interpolation(i), & + si=self%solution(pn, s)%si_i(i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights_i(i, 0:self%ui%S(s)-1)) + enddo + enddo + deallocate(stencil_i) + enddo + else + do s=1, self%ui%S_number + call wenoof_create(interpolator_type='reconstructor-'//trim(adjustl(self%ui%interpolator_type)), & + S=self%ui%S(s), & + interpolator=interpolator, & + eps=self%ui%eps) + if (self%ui%verbose) print '(A)', interpolator%description() + allocate(stencil_r(1:2, 1-self%ui%S(s):-1+self%ui%S(s))) + do pn=1, self%ui%pn_number + do i=1, self%ui%points_number(pn) + stencil_r(1,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + stencil_r(2,:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) + call interpolator%interpolate(stencil=stencil_r, & + interpolation=self%solution(pn, s)%interpolations(:,i), & + si=self%solution(pn, s)%si_r(:, i, 0:self%ui%S(s)-1), & + weights=self%solution(pn, s)%weights_r(:, i, 0:self%ui%S(s)-1)) + self%solution(pn, s)%reconstruction(i) = & + (self%solution(pn, s)%interpolations(2,i) - self%solution(pn, s)%interpolations(1,i))/self%solution(pn, s)%Dx + enddo + enddo + deallocate(stencil_r) + enddo + endif + call self%analize_errors + call self%save_results_and_plots + endsubroutine perform + + subroutine save_results_and_plots(self) + !< Save results and plots. + class(test), intent(inout) :: self !< Test. + type(pyplot) :: plt !< Plot handler. + character(len=:), allocatable :: buffer !< Buffer string. + character(len=:), allocatable :: output_dir !< Output directory. + character(len=:), allocatable :: file_bname !< File base name. + integer(I_P) :: file_unit !< File unit. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + integer(I_P) :: ss !< Counter. + integer(I_P) :: f !< Counter. + + output_dir = trim(adjustl(self%ui%output_dir))//'/' + if (self%ui%results.or.self%ui%plots) call execute_command_line('mkdir -p '//output_dir) + if (self%ui%interpolate) then + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-interpolator-'//trim(adjustl(self%ui%interpolator_type)) + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "sin(x)" "x_int" "sin(x)_int" "interpolation"' + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.)) + enddo + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.)) + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + x_int => self%solution(pn, s)%x_int, & + fx_int => self%solution(pn, s)%fx_int, & + interpolation => self%solution(pn, s)%interpolation, & + si => self%solution(pn, s)%si_i, & + weights => self%solution(pn, s)%weights_i, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(5+2*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + x_int(i), & + fx_int(i), & + interpolation(i), & + (si(i, ss), ss=0, self%ui%S(s)-1), & + (weights(i, ss), ss=0, self%ui%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + self%solution(pn, s)%error_L2, & + self%accuracy(pn, s), & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + else + file_bname = output_dir//trim(adjustl(self%ui%output_bname))//'-reconstructor-'//trim(adjustl(self%ui%interpolator_type)) + if (self%ui%results) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + open(newunit=file_unit, file=file_bname//'-S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.dat') + buffer = 'VARIABLES = "x" "sin(x)" "cos(x)" "x_left" "x_right" "sin(x)_left" "sin(x)_right"' + buffer = buffer//' "reconstruction_left" "reconstruction_right" "cos_reconstruction"' + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "si-'//trim(str(ss, .true.))//'_left"'//' "si-'//trim(str(ss, .true.))//'_right"' + enddo + do ss=0, self%ui%S(s)-1 + buffer = buffer//' "W-'//trim(str(ss, .true.))//'_left"'//' "W-'//trim(str(ss, .true.))//'_right"' + enddo + write(file_unit, "(A)") buffer + write(file_unit, "(A)") 'ZONE T = "'//'S_'//trim(str(self%ui%S(s), .true.))//& + '-Np_'//trim(str(self%ui%points_number(pn), .true.))//'"' + associate(x_cell => self%solution(pn, s)%x_cell, & + fx_cell => self%solution(pn, s)%fx_cell, & + dfx_cell => self%solution(pn, s)%dfx_cell, & + x_face => self%solution(pn, s)%x_face, & + fx_face => self%solution(pn, s)%fx_face, & + interpolations => self%solution(pn, s)%interpolations, & + reconstruction => self%solution(pn, s)%reconstruction, & + si => self%solution(pn, s)%si_r, & + weights => self%solution(pn, s)%weights_r, & + Dx => self%solution(pn, s)%Dx) + do i = 1, self%ui%points_number(pn) + write(file_unit, "("//trim(str(10+4*self%ui%S(s), .true.))//"("//FRPP//",1X))") & + x_cell(i), & + fx_cell(i), & + dfx_cell(i), & + (x_face(f,i), f=1, 2), & + (fx_face(f,i), f=1, 2), & + (interpolations(f,i), f=1, 2), & + reconstruction(i), & + ((si(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1), & + ((weights(f, i, ss), f=1, 2), ss=0, self%ui%S(s)-1) + enddo + endassociate + close(file_unit) + enddo + enddo + + if (self%ui%errors_analysis.and.self%ui%pn_number>1) then + open(newunit=file_unit, file=file_bname//'-accuracy.dat') + write(file_unit, "(A)") 'VARIABLES = "S" "Np" "error (L2)" "observed order" "formal order"' + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + write(file_unit, "(2(I5,1X),"//FRPP//",1X,F5.2,1X,I3)") self%ui%S(s), & + self%ui%points_number(pn), & + self%solution(pn, s)%error_L2, & + self%accuracy(pn, s), & + 2*self%ui%S(s)-1 + enddo + enddo + close(file_unit) + endif + endif + endif + +#ifndef r16p + ! pyplot fortran does not support 128 bit reals + if (self%ui%plots) then + if (self%ui%interpolate) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + buffer = 'WENO interpolation of $\sin(x)$; '//& + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%fx_cell(:), & + label='$\sin(x)$', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_int(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%interpolation(:), & + label='WENO interpolation', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') + enddo + enddo + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + buffer = 'WENO reconstruction of $d \sin(x)/Dx=\cos(x)$; '//& + 'S='//trim(str(self%ui%S(s), .true.))//'Np='//trim(str(self%ui%points_number(pn), .true.)) + call plt%initialize(grid=.true., xlabel='angle (rad)', title=buffer, legend=.true.) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%dfx_cell(:), & + label='$\cos(x)$', & + linestyle='k-', & + linewidth=2, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%add_plot(x=self%solution(pn, s)%x_cell(1:self%ui%points_number(pn)), & + y=self%solution(pn, s)%reconstruction(:), & + label='WENO reconstruction', & + linestyle='ro', & + markersize=6, & + ylim=[-1.1_RPP, 1.1_RPP]) + call plt%savefig(file_bname//& + '-S_'//trim(str(self%ui%S(s), .true.))//'-Np_'//trim(str(self%ui%points_number(pn), .true.))//'.png') + enddo + enddo + endif + endif +#endif + endsubroutine save_results_and_plots + + subroutine analize_errors(self) + !< Analize errors. + class(test), intent(inout) :: self !< Test. + integer(I_P) :: s !< Counter. + integer(I_P) :: pn !< Counter. + integer(I_P) :: i !< Counter. + + if (self%ui%errors_analysis) then + if (self%ui%interpolate) then + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + fx_int=>self%solution(pn, s)%fx_int, & + interpolation=>self%solution(pn, s)%interpolation) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + error_L2 = error_L2 + (interpolation(i) - fx_int(i))**2 + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + endif + else + do s=1, self%ui%S_number + do pn=1, self%ui%pn_number + associate(error_L2=>self%solution(pn, s)%error_L2, & + Dx=>self%solution(pn, s)%Dx, & + dfx_cell=>self%solution(pn, s)%dfx_cell, & + reconstruction=>self%solution(pn, s)%reconstruction) + error_L2 = 0._RPP + do i=1, self%ui%points_number(pn) + error_L2 = error_L2 + (reconstruction(i) - dfx_cell(i))**2 + enddo + error_L2 = sqrt(error_L2) + endassociate + enddo + enddo + if (self%ui%pn_number>1) then + do s=1, self%ui%S_number + do pn=2, self%ui%pn_number + self%accuracy(pn, s) = log(self%solution(pn - 1, s)%error_L2 / self%solution(pn, s)%error_L2) / & + log(self%solution(pn - 1, s)%Dx / self%solution(pn, s)%Dx) + enddo + enddo + endif + endif + endif + endsubroutine analize_errors +endmodule sin_test_module + +program sin_test_program +!< WenOOF test: interpolation or reconstruction of sine function. + +use sin_test_module + +implicit none +type(test) :: sin_test + +call sin_test%execute +endprogram sin_test_program diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 index a465e97..699d2a1 100644 --- a/src/tests/wenoof_test_ui.f90 +++ b/src/tests/wenoof_test_ui.f90 @@ -29,7 +29,9 @@ module wenoof_test_ui integer(I_P), allocatable :: points_number(:) !< Points number used to discretize the domain. integer(I_P) :: S_number !< Number of different stencils tested. integer(I_P), allocatable :: S(:) !< Stencils used. - real(RPP) :: eps !< Smal episol to avoid zero-division. + real(RPP) :: eps !< Small epsilon to avoid zero-division. + real(RPP) :: x_target !< Interpolation target coordinate. + logical :: interpolate !< Flag for activating interpolation. logical :: errors_analysis=.false. !< Flag for activating errors analysis. logical :: plots=.false. !< Flag for activating plots saving. logical :: results=.false. !< Flag for activating results saving. @@ -57,23 +59,63 @@ subroutine set_cli() authors = 'Fortran-FOSS-Programmers', & license = 'GNU GPLv3', & description = 'Test WenOOF library on function reconstruction', & - examples = ["$EXECUTABLE --interpolator JS --results", & - "$EXECUTABLE --interpolator JS-Z -r ", & - "$EXECUTABLE --interpolator JS-M ", & - "$EXECUTABLE --interpolator all -p -r "]) - call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator/recontructor type', required=.false., & - def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') - call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & - required=.false., act='store', def='50 100') - call cli%add(switch='--stencils', switch_ab='-s', nargs='+', help='Stencils dimensions (and number)', & - required=.false., act='store', def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') - call cli%add(switch='--eps', help='Small epsilon to avoid zero-division', required=.false., act='store', def='1.e-6') - call cli%add(switch='--output_dir', help='Output directory', required=.false., act='store', def='./') - call cli%add(switch='--results', switch_ab='-r', help='Save results', required=.false., act='store_true', def='.false.') - call cli%add(switch='--plots', switch_ab='-p', help='Save plots', required=.false., act='store_true', def='.false.') - call cli%add(switch='--output', help='Output files basename', required=.false., act='store', def='output') - call cli%add(switch='--errors_analysis', help='Peform errors analysis', required=.false., act='store_true', def='.false.') - call cli%add(switch='--verbose', help='Verbose output', required=.false., act='store_true', def='.false.') + examples = ["$EXECUTABLE interpolate -i JS --results", & + "$EXECUTABLE interpolate -i JS-Z -r ", & + "$EXECUTABLE reconstruct -i JS-M ", & + "$EXECUTABLE reconstruct -i all -p -r "]) + + call cli%add_group(group='interpolate', description='perform WENO interpolation') + call cli%add (group='interpolate', switch='--x_target', switch_ab='-x', & + help='WENO interpolation target point coordinate', & + required=.true., def='0', act='store') + call cli%add (group='interpolate', switch='--interpolator', switch_ab='-i', & + help='WENO interpolator type', required=.false., & + def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') + call cli%add (group='interpolate', switch='--points_number', switch_ab='-pn', nargs='+', & + help='Number of points used to discretize the domain', & + required=.false., act='store', def='50 100') + call cli%add (group='interpolate', switch='--stencils', switch_ab='-s', nargs='+', & + help='Stencils dimensions (and number)', required=.false., act='store', & + def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') + call cli%add (group='interpolate', switch='--eps', help='Small epsilon to avoid zero-division', & + required=.false., act='store', def='1.e-6') + call cli%add (group='interpolate', switch='--output_dir', help='Output directory', required=.false., & + act='store', def='./') + call cli%add (group='interpolate', switch='--results', switch_ab='-r', help='Save results', required=.false., & + act='store_true', def='.false.') + call cli%add (group='interpolate', switch='--plots', switch_ab='-p', help='Save plots', required=.false., & + act='store_true', def='.false.') + call cli%add (group='interpolate', switch='--output', help='Output files basename', required=.false., & + act='store', def='output') + call cli%add (group='interpolate', switch='--errors_analysis', help='Peform errors analysis', required=.false., & + act='store_true', def='.false.') + call cli%add (group='interpolate', switch='--verbose', help='Verbose output', required=.false., & + act='store_true', def='.false.') + + call cli%add_group(group='reconstruct', description='perform WENO reconstruction') + call cli%add (group='reconstruct', switch='--interpolator', switch_ab='-i', & + help='WENO interpolator type', required=.false., & + def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') + call cli%add (group='reconstruct', switch='--points_number', switch_ab='-pn', nargs='+', & + help='Number of points used to discretize the domain', & + required=.false., act='store', def='50 100') + call cli%add (group='reconstruct', switch='--stencils', switch_ab='-s', nargs='+', & + help='Stencils dimensions (and number)', required=.false., act='store', & + def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') + call cli%add (group='reconstruct', switch='--eps', help='Small epsilon to avoid zero-division', & + required=.false., act='store', def='1.e-6') + call cli%add (group='reconstruct', switch='--output_dir', help='Output directory', required=.false., & + act='store', def='./') + call cli%add (group='reconstruct', switch='--results', switch_ab='-r', help='Save results', required=.false., & + act='store_true', def='.false.') + call cli%add (group='reconstruct', switch='--plots', switch_ab='-p', help='Save plots', required=.false., & + act='store_true', def='.false.') + call cli%add (group='reconstruct', switch='--output', help='Output files basename', required=.false., & + act='store', def='output') + call cli%add (group='reconstruct', switch='--errors_analysis', help='Peform errors analysis', required=.false., & + act='store_true', def='.false.') + call cli%add (group='reconstruct', switch='--verbose', help='Verbose output', required=.false., & + act='store_true', def='.false.') endassociate endsubroutine set_cli @@ -81,16 +123,44 @@ subroutine parse_cli() !< Parse Command Line Interface and check its validity. call self%cli%parse(error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(switch='-pn', val=self%points_number, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--output_dir', val=self%output_dir, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--errors_analysis', val=self%errors_analysis, error=self%error) ; if (self%error/=0) stop - call self%cli%get(switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop + if (self%cli%run_command(group='interpolate')) then + self%interpolate=.true. + call self%cli%get(group='interpolate', switch='-x', val=self%x_target, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop + call self%cli%get_varying(group='interpolate', switch='-pn', val=self%points_number, error=self%error) + if (self%error/=0) stop + call self%cli%get_varying(group='interpolate', switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='--output_dir', val=self%output_dir, error=self%error) + if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='--errors_analysis', val=self%errors_analysis, error=self%error) + if (self%error/=0) stop + call self%cli%get(group='interpolate', switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop + elseif (self%cli%run_command(group='reconstruct')) then + self%interpolate=.false. + call self%cli%get(group='reconstruct', switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop + call self%cli%get_varying(group='reconstruct', switch='-pn', val=self%points_number, error=self%error) + if (self%error/=0) stop + call self%cli%get_varying(group='reconstruct', switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='--output_dir', val=self%output_dir, error=self%error) + if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='--errors_analysis', val=self%errors_analysis, error=self%error) + if (self%error/=0) stop + call self%cli%get(group='reconstruct', switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop + else +#ifndef DEBUG + ! error stop in pure procedure is a F2015 feature not yet supported in debug mode + call self%cli%print_usage + error stop 'error: action not present; choose the correct action between "interpolate" and "reconstruct"' +#endif + endif self%pn_number = size(self%points_number, dim=1) self%S_number = size(self%S, dim=1) From 09b84c0b62cab4a1100cac58fbf2d90a0019946e Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 20 Mar 2017 10:57:02 +0100 Subject: [PATCH 64/90] fix wrong cycle; still not working --- src/lib/wenoof.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index d3130da..d16ae09 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -50,8 +50,8 @@ subroutine wenoof_create_interpolator(interpolator_type, S, x_target, interpolat error stop 'error: x_target must be between -0.5 and 0.5, that represent left and right cell interfaces' endif allocate(stencil(1-S:S-1)) - do i=0,2*S-2 - stencil(i) = 1.0_RPP - S + i + do i=1,2*S-1 + stencil(-S+i) = 1.0_RPP - S + i enddo call factory%create(interpolator_type='interpolator-'//interpolator_type, & S=S, & From 992d34ecc8c1b531cd9230d62c0657d1902e1b72 Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Wed, 29 Mar 2017 16:36:02 +0200 Subject: [PATCH 65/90] fix silly bugs --- src/lib/factories/wenoof_alpha_factory.f90 | 4 ++++ src/lib/wenoof.F90 | 16 ++++++++-------- 2 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/lib/factories/wenoof_alpha_factory.f90 b/src/lib/factories/wenoof_alpha_factory.f90 index c6dceb6..6835ef9 100644 --- a/src/lib/factories/wenoof_alpha_factory.f90 +++ b/src/lib/factories/wenoof_alpha_factory.f90 @@ -2,6 +2,7 @@ module wenoof_alpha_factory !< Wenoof alpha factory. +use, intrinsic :: iso_fortran_env, only : stderr=>error_unit #ifdef r16p use penf, only: I_P, RPP=>R16P #else @@ -92,6 +93,9 @@ subroutine create_constructor(interpolator_type, S, constructor, eps) endselect case('reconstructor-Z') allocate(alpha_rec_z_constructor :: constructor) + case default + write(stderr, '(A)') 'error: interpolator type "'//trim(adjustl(interpolator_type))//'" is unknown!' + stop endselect call constructor%create(S=S, eps=eps) endsubroutine create_constructor diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index d16ae09..06ed881 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -29,9 +29,9 @@ subroutine wenoof_create_reconstructor(interpolator_type, S, interpolator, eps) real(RPP), intent(in), optional :: eps !< Small epsilon to avoid zero-div. type(objects_factory) :: factory !< The factory. - call factory%create(interpolator_type='reconstructor-'//interpolator_type, & - S=S, & - interpolator=interpolator, & + call factory%create(interpolator_type=interpolator_type, & + S=S, & + interpolator=interpolator, & eps=eps) endsubroutine wenoof_create_reconstructor @@ -53,11 +53,11 @@ subroutine wenoof_create_interpolator(interpolator_type, S, x_target, interpolat do i=1,2*S-1 stencil(-S+i) = 1.0_RPP - S + i enddo - call factory%create(interpolator_type='interpolator-'//interpolator_type, & - S=S, & - interpolator=interpolator, & - stencil=stencil, & - x_target=x_target, & + call factory%create(interpolator_type=interpolator_type, & + S=S, & + interpolator=interpolator, & + stencil=stencil, & + x_target=x_target, & eps=eps) endsubroutine wenoof_create_interpolator endmodule wenoof From a4dc8bd487d244a55c4ea5eedd64d793872df1aa Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 30 Mar 2017 18:57:47 +0200 Subject: [PATCH 66/90] Fixed severe bugs --- src/lib/abstract_objects/wenoof_kappa_object.F90 | 12 ++++++------ .../concrete_objects/wenoof_interpolator_js.F90 | 6 ++++-- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 14 +++++++------- src/lib/concrete_objects/wenoof_kappa_rec_js.F90 | 6 +++--- src/lib/factories/wenoof_kappa_factory.f90 | 4 ++++ 5 files changed, 24 insertions(+), 18 deletions(-) diff --git a/src/lib/abstract_objects/wenoof_kappa_object.F90 b/src/lib/abstract_objects/wenoof_kappa_object.F90 index b0ac678..b395b02 100644 --- a/src/lib/abstract_objects/wenoof_kappa_object.F90 +++ b/src/lib/abstract_objects/wenoof_kappa_object.F90 @@ -3,9 +3,9 @@ module wenoof_kappa_object !< Abstract Kappa (optimal, linear weights of stencil interpolations) object. #ifdef r16p -use penf, only: RPP=>R16P +use penf, only: I_P, RPP=>R16P #else -use penf, only: RPP=>R8P +use penf, only: I_P, RPP=>R8P #endif use wenoof_base_object @@ -42,10 +42,10 @@ pure subroutine compute_kappa_rec_interface(self) pure subroutine compute_kappa_int_interface(self, stencil, x_target) !< Compute kappa. - import :: kappa_object, RPP - class(kappa_object), intent(inout) :: self !< Kappa. - real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + import :: kappa_object, I_P, RPP + class(kappa_object), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. endsubroutine compute_kappa_int_interface endinterface diff --git a/src/lib/concrete_objects/wenoof_interpolator_js.F90 b/src/lib/concrete_objects/wenoof_interpolator_js.F90 index fe4bab6..05d3b1e 100644 --- a/src/lib/concrete_objects/wenoof_interpolator_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolator_js.F90 @@ -49,12 +49,14 @@ subroutine create(self, constructor) !< Create interpolator. class(interpolator_js), intent(inout) :: self !< Interpolator. class(base_object_constructor), intent(in) :: constructor !< Constructor. + type(interpolations_factory) :: i_factory !< Inteprolations factory. type(weights_factory) :: w_factory !< Weights factory. call self%destroy call self%create_(constructor=constructor) select type(constructor) class is(interpolator_object_constructor) + call i_factory%create(constructor=constructor%interpolations_constructor, object=self%interpolations) call w_factory%create(constructor=constructor%weights_constructor, object=self%weights) endselect endsubroutine create @@ -83,7 +85,7 @@ pure subroutine interpolate_with_stencil_of_rank_1_debug(self, stencil, interpol !< Interpolate values (providing also debug values). class(interpolator_js), intent(inout) :: self !< Interpolator. real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. - real(RPP), intent(out) :: interpolation !< Result of the interpolation, [1:2]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation. real(RPP), intent(out) :: si(0:) !< Computed values of smoothness indicators [1:2, 0:S-1]. real(RPP), intent(out) :: weights(0:) !< Weights of the stencils, [1:2, 0:S-1]. @@ -107,7 +109,7 @@ pure subroutine interpolate_with_stencil_of_rank_1_standard(self, stencil, inter !< Interpolate values (without providing debug values). class(interpolator_js), intent(inout) :: self !< Interpolator. real(RPP), intent(in) :: stencil(1 - self%S:) !< Stencil of the interpolation [1:2, 1-S:-1+S]. - real(RPP), intent(out) :: interpolation !< Result of the interpolation, [1:2]. + real(RPP), intent(out) :: interpolation !< Result of the interpolation. integer(I_P) :: s !< Counters. call self%interpolations%compute(stencil=stencil) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index d5d1e35..8151937 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -75,13 +75,13 @@ pure subroutine compute_kappa_rec(self) pure subroutine compute_kappa_int(self, stencil, x_target) !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. - real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. - real(RPP), allocatable :: coeff(:) !< Interpolation coefficients on the whole stencil. - real(RPP) :: prod !< Temporary variable. - real(RPP) :: coeff_t !< Temporary variable. - integer(I_P) :: i, j, k !< Counters. + class(kappa_int_js), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + real(RPP), allocatable :: coeff(:) !< Interpolation coefficients on the whole stencil. + real(RPP) :: prod !< Temporary variable. + real(RPP) :: coeff_t !< Temporary variable. + integer(I_P) :: i, j, k !< Counters. associate(S => self%S, val => self%values_rank_1, interp => self%interpolations) if(x_target==-0.5_RPP) then diff --git a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 index c556d56..fe7a975 100644 --- a/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_rec_js.F90 @@ -181,9 +181,9 @@ pure subroutine compute_kappa_rec(self) pure subroutine compute_kappa_int(self, stencil, x_target) !< Compute kappa. - class(kappa_rec_js), intent(inout) :: self !< Kappa. - real(RPP), intent(in) :: stencil(:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + class(kappa_rec_js), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. ! Empty Subroutine endsubroutine compute_kappa_int diff --git a/src/lib/factories/wenoof_kappa_factory.f90 b/src/lib/factories/wenoof_kappa_factory.f90 index bc918b6..27e803b 100644 --- a/src/lib/factories/wenoof_kappa_factory.f90 +++ b/src/lib/factories/wenoof_kappa_factory.f90 @@ -68,5 +68,9 @@ subroutine create_constructor_int(interpolator_type, S, stencil, x_target, inter constructor%stencil = stencil constructor%x_target = x_target call constructor%create(S=S) + select type(constructor) + type is(kappa_int_js_constructor) + allocate(constructor%interpolations_constructor, source=interpolations_constructor) + endselect endsubroutine create_constructor_int endmodule wenoof_kappa_factory From d3a74d00584392e9e74dc3a0f8b7a04475b684ea Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 30 Mar 2017 19:00:15 +0200 Subject: [PATCH 67/90] exclude FORESEER test directory --- fobos | 1 + 1 file changed, 1 insertion(+) diff --git a/fobos b/fobos index 037edfb..a57491f 100644 --- a/fobos +++ b/fobos @@ -18,6 +18,7 @@ $EXDIRS = FACE/src/tests FACE/src/third_party/ PENF/src/tests/ PENF/src/third_party/ FOODIE/src/tests FOODIE/src/third_party/ pyplot-fortran/src/tests/ + FORESEER/src/tests/ # main modes # GNU From bd31f3a015af11a758a8c48c3984fe671c39d1fb Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Mon, 3 Apr 2017 15:04:58 +0200 Subject: [PATCH 68/90] remove redundant interpolations create call --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 8151937..25e1166 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -60,7 +60,6 @@ subroutine create(self, constructor) select type(constructor) type is(kappa_int_js_constructor) associate(interpolations_constructor=>constructor%interpolations_constructor) - call i_factory%create(constructor=interpolations_constructor, object=self%interpolations) call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) endassociate endselect From e77e4ee159c94b44502176430051d2d323aa9d0e Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 4 Apr 2017 09:22:03 +0200 Subject: [PATCH 69/90] fixed wrong IS coefficients --- src/lib/concrete_objects/wenoof_beta_int_js.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_beta_int_js.F90 b/src/lib/concrete_objects/wenoof_beta_int_js.F90 index 03db3c5..9c3ca18 100644 --- a/src/lib/concrete_objects/wenoof_beta_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_beta_int_js.F90 @@ -109,7 +109,7 @@ subroutine create(self, constructor) ! (i+1)*(i+1) ; i*(i+1) ; (i-1)*(i+1) c(0,0,1) = 6649._RPP / 2880._RPP; c(1,0,1) = -5069._RPP / 480._RPP; c(2,0,1) = 1283._RPP / 160._RPP ! (i-2)*(i+1) - c(3,0,1) = -2899._RPP / 1440._RPP + c(3,0,1) = -2989._RPP / 1440._RPP ! / ; i*i ; (i-1)*i c(0,1,1) = 0._RPP ; c(1,1,1) = 13667._RPP / 960._RPP; c(2,1,1) =-11767._RPP / 480._RPP ! (i-2)*i @@ -232,7 +232,7 @@ subroutine create(self, constructor) ! / ; / ; (i+1)*(i+1) c(0,2,3) = 0._RPP ; c(1,2,3) = 0._RPP ; c(2,2,3) = 539351._RPP / 6720._RPP ! i*(i+1) ; (i-1)*(i+1) - c(3,2,3) = -3062520._RPP / 2520._RPP; c(4,2,3) = 671329._RPP / 20160._RPP + c(3,2,3) = -306569._RPP / 2520._RPP; c(4,2,3) = 671329._RPP / 20160._RPP ! / ; / ; / c(0,3,3) = 0._RPP ; c(1,3,3) = 0._RPP ; c(2,3,3) = 0._RPP ! i*i ; (i-1)*i @@ -477,7 +477,7 @@ subroutine create(self, constructor) ! / ; (i-3)*(i-3) c(2,3,0) = 0._RPP; c(3,3,0) = 2558389867._RPP/148729._RPP ! (i-4)*(i-3) ; (i-5)*(i-3) - c(4,3,0) = -1833856939._RPP/80705._RPP; c(5,3,0) = 2369766527._RPP/4292389._RPP + c(4,3,0) = -1833856939._RPP/80705._RPP; c(5,3,0) = 2369766527._RPP/292389._RPP ! (i-6)*(i-3) c(6,3,0) = -219701291._RPP/180490._RPP @@ -1995,7 +1995,7 @@ subroutine create(self, constructor) ! / ; / c(0,2,5) = 0._RPP;c(1,2,5) = 0._RPP ! / ; / - c(2,2,5) = 2253530669._RPP/ 1605103._RPP;c(3,2,5) = -628691758._RPP/ 628691758._RPP + c(2,2,5) = 2253530669._RPP/ 1605103._RPP;c(3,2,5) = -628691758._RPP/ 105883._RPP ! / ; / c(4,2,5) = 1581790037._RPP/ 203396._RPP;c(5,2,5) = -295058921._RPP/ 45739._RPP ! / ; / From e1b57e861fa003ca1582821eab724a14e324809f Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 4 Apr 2017 09:31:22 +0200 Subject: [PATCH 70/90] trim out dangerous --recursive --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index fbe831e..b117fd2 100644 --- a/.travis.yml +++ b/.travis.yml @@ -27,7 +27,7 @@ env: - MAKETAR="FoBiS.py rule -ex maketar" before_install: - - git submodule update --init --recursive + - git submodule update --init install: - | From add24bfab8bf48fe22a50a3be1e61279c7631994 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 4 Apr 2017 09:46:14 +0200 Subject: [PATCH 71/90] fix wrong array name --- src/tests/polynoms_test.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/polynoms_test.f90 b/src/tests/polynoms_test.f90 index 19e40f1..cd04ed1 100644 --- a/src/tests/polynoms_test.f90 +++ b/src/tests/polynoms_test.f90 @@ -403,7 +403,7 @@ subroutine save_results_and_plots(self) linewidth=2, & ylim=[-1.1_RPP, 1.1_RPP]) call plt%add_plot(x=self%solution(pn, s)%x_int(1:self%ui%points_number(pn)), & - y=self%solution(pn, s)%interpolations(:), & + y=self%solution(pn, s)%interpolation(:), & label='WENO interpolation', & linestyle='ro', & markersize=6, & From eb94c55ecddfa2ffc076c15392d6706cd94a2c02 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 4 Apr 2017 12:13:03 +0200 Subject: [PATCH 72/90] impose interpolation coefficients sum to 1 --- src/lib/concrete_objects/wenoof_interpolations_int_js.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index f048d76..5a34c41 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -46,6 +46,7 @@ subroutine create(self, constructor) class(interpolations_int_js), intent(inout) :: self !< Interpolations. class(base_object_constructor), intent(in) :: constructor !< Interpolations constructor. real(RPP) :: prod !< Temporary variable. + real(RPP) :: c_sum !< Temporary variable. integer(I_P) :: i, j, k !< Counters. call self%destroy @@ -321,14 +322,17 @@ subroutine create(self, constructor) else ! internal point do k=0,S-1 !stencils loop - do j=0,S-1 !values loop + c_sum = 0._RPP + do j=0,S-2 !values loop prod = 1._RPP do i=0,S-1 if (i==j) cycle prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j+1) - stencil(-S+k+i+1))) enddo c(j,k) = prod + c_sum = c_sum + prod enddo + c(S-1,k) = 1._RPP - c_sum enddo endif endassociate From 56c1b0883b2d62a3920380c8a50815c636e4acff Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Tue, 4 Apr 2017 13:24:10 +0200 Subject: [PATCH 73/90] impose kappa coefficients sum to 1 --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 25e1166..eb23a1a 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -80,6 +80,7 @@ pure subroutine compute_kappa_int(self, stencil, x_target) real(RPP), allocatable :: coeff(:) !< Interpolation coefficients on the whole stencil. real(RPP) :: prod !< Temporary variable. real(RPP) :: coeff_t !< Temporary variable. + real(RPP) :: val_sum !< Temporary variable. integer(I_P) :: i, j, k !< Counters. associate(S => self%S, val => self%values_rank_1, interp => self%interpolations) @@ -208,7 +209,8 @@ pure subroutine compute_kappa_int(self, stencil, x_target) enddo select type(interp) type is(interpolations_int_js) - do j = 0,S-1 + val_sum = 0._RPP + do j = 0,S-2 coeff_t = 0._RPP k = j do i = 0,j-1 @@ -216,7 +218,9 @@ pure subroutine compute_kappa_int(self, stencil, x_target) k = k - 1 enddo val(j) = (coeff(j) - coeff_t) / interp%coef(0,j) + val_sum = val_sum + val(j) enddo + val(S-1) = 1._RPP - val_sum endselect deallocate(coeff) endif From 0ecdb297d454522aae502936b39aaa117a15ffc0 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 5 Apr 2017 10:29:09 +0200 Subject: [PATCH 74/90] interpolations create call is not redundantgit add src/lib/concrete_objects/wenoof_kappa_int_js.F90! correct commit bd31f3a015af11a758a8c48c3984fe671c39d1fb --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index eb23a1a..908907c 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -60,6 +60,7 @@ subroutine create(self, constructor) select type(constructor) type is(kappa_int_js_constructor) associate(interpolations_constructor=>constructor%interpolations_constructor) + call i_factory%create(constructor=interpolations_constructor, object=self%interpolations) call self%compute(stencil=constructor%stencil, x_target=constructor%x_target) endassociate endselect From d0aa73835e617b31d02749c82dc219f6b53e6ebb Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 5 Apr 2017 10:29:33 +0200 Subject: [PATCH 75/90] fix format --- src/tests/sin_test.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/sin_test.f90 b/src/tests/sin_test.f90 index fc49ed4..4e3504c 100644 --- a/src/tests/sin_test.f90 +++ b/src/tests/sin_test.f90 @@ -218,7 +218,7 @@ subroutine perform(self) do pn=1, self%ui%pn_number do i=1, self%ui%points_number(pn) stencil_i(:) = self%solution(pn, s)%fx_cell(i+1-self%ui%S(s):i-1+self%ui%S(s)) - call interpolator%interpolate(stencil=stencil_i, & + call interpolator%interpolate(stencil=stencil_i, & interpolation=self%solution(pn, s)%interpolation(i), & si=self%solution(pn, s)%si_i(i, 0:self%ui%S(s)-1), & weights=self%solution(pn, s)%weights_i(i, 0:self%ui%S(s)-1)) From d054aa1d42ad67b8e61365cc5bad61cb8ec96fba Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 5 Apr 2017 14:42:44 +0200 Subject: [PATCH 76/90] exclude FLOw directory --- fobos | 1 + 1 file changed, 1 insertion(+) diff --git a/fobos b/fobos index a57491f..bfe15ea 100644 --- a/fobos +++ b/fobos @@ -17,6 +17,7 @@ $EXDIRS = FACE/src/tests FACE/src/third_party/ FLAP/src/tests/ FLAP/src/third_party/ PENF/src/tests/ PENF/src/third_party/ FOODIE/src/tests FOODIE/src/third_party/ + FLOw/src FLOw/src/tests FLOw/src/third_party/ pyplot-fortran/src/tests/ FORESEER/src/tests/ From ec5926193ffce79af72e7d779fc42eda2f3f5c36 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Wed, 5 Apr 2017 14:45:31 +0200 Subject: [PATCH 77/90] fix severe bug in kappa evaluation --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index 908907c..fd7b790 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -78,7 +78,8 @@ pure subroutine compute_kappa_int(self, stencil, x_target) class(kappa_int_js), intent(inout) :: self !< Kappa. real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for interpolation, [1-S:S-1]. real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. - real(RPP), allocatable :: coeff(:) !< Interpolation coefficients on the whole stencil. + real(RPP) :: coeff(0:2*self%S-2) !< Interpolation coefficients on the whole stencil. + real(RPP) :: ffeoc(0:2*self%S-2) !< Temporary variable. real(RPP) :: prod !< Temporary variable. real(RPP) :: coeff_t !< Temporary variable. real(RPP) :: val_sum !< Temporary variable. @@ -199,15 +200,15 @@ pure subroutine compute_kappa_int(self, stencil, x_target) endselect else ! internal point - allocate(coeff(0:2*S-2)) do j=0,2*S-2 !values loop prod = 1._RPP do i=0,2*S-2 if (i==j) cycle prod = prod * ((x_target - stencil(-S+i+1)) / (stencil(-S+j+1) - stencil(-S+i+1))) enddo - coeff(j) = prod + ffeoc(j) = prod enddo + coeff = ffeoc(2*S-2:0:-1) select type(interp) type is(interpolations_int_js) val_sum = 0._RPP @@ -223,7 +224,6 @@ pure subroutine compute_kappa_int(self, stencil, x_target) enddo val(S-1) = 1._RPP - val_sum endselect - deallocate(coeff) endif endassociate endsubroutine compute_kappa_int From 1be1b3c24780312ec2026b52444f937a9921a588 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 12:03:15 +0200 Subject: [PATCH 78/90] fix wrong stencil expression --- src/lib/wenoof.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/lib/wenoof.F90 b/src/lib/wenoof.F90 index 06ed881..6484a4c 100644 --- a/src/lib/wenoof.F90 +++ b/src/lib/wenoof.F90 @@ -50,8 +50,8 @@ subroutine wenoof_create_interpolator(interpolator_type, S, x_target, interpolat error stop 'error: x_target must be between -0.5 and 0.5, that represent left and right cell interfaces' endif allocate(stencil(1-S:S-1)) - do i=1,2*S-1 - stencil(-S+i) = 1.0_RPP - S + i + do i=0,2*S-2 + stencil(-S+1+i) = 1.0_RPP - S + i enddo call factory%create(interpolator_type=interpolator_type, & S=S, & From b40f19a05c53d5541031ad51c87d768db3f235f7 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 14:41:48 +0200 Subject: [PATCH 79/90] remove unused variables --- src/tests/polynoms_test.f90 | 3 --- src/tests/sin_test.f90 | 3 --- src/tests/wenoof_test_ui.f90 | 1 - 3 files changed, 7 deletions(-) diff --git a/src/tests/polynoms_test.f90 b/src/tests/polynoms_test.f90 index cd04ed1..ad476d6 100644 --- a/src/tests/polynoms_test.f90 +++ b/src/tests/polynoms_test.f90 @@ -66,7 +66,6 @@ module polynoms_test_module subroutine execute(self) !< Execute test(s). class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. call self%ui%get if (trim(adjustl(self%ui%interpolator_type))/='all') then @@ -196,8 +195,6 @@ subroutine deallocate_solution_data(self) subroutine perform(self) !< Perform the test. class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:) !< Observed order based on subsequent refined solutions. class(interpolator_object), allocatable :: interpolator !< WENO interpolator. real(RPP), allocatable :: stencil_i(:) !< Stencils used for interpolation. real(RPP), allocatable :: stencil_r(:,:) !< Stencils used for reconstruction. diff --git a/src/tests/sin_test.f90 b/src/tests/sin_test.f90 index 4e3504c..b2f68b7 100644 --- a/src/tests/sin_test.f90 +++ b/src/tests/sin_test.f90 @@ -66,7 +66,6 @@ module sin_test_module subroutine execute(self) !< Execute test(s). class(test), intent(inout) :: self !< Test. - integer(I_P) :: s !< Counter. call self%ui%get if (trim(adjustl(self%ui%interpolator_type))/='all') then @@ -196,8 +195,6 @@ subroutine deallocate_solution_data(self) subroutine perform(self) !< Perform the test. class(test), intent(inout) :: self !< Test. - real(RPP), allocatable :: error(:) !< Error (norm L2) with respect the exact solution. - real(RPP), allocatable :: order(:) !< Observed order based on subsequent refined solutions. class(interpolator_object), allocatable :: interpolator !< WENO interpolator. real(RPP), allocatable :: stencil_i(:) !< Stencils used for interpolation. real(RPP), allocatable :: stencil_r(:,:) !< Stencils used for reconstruction. diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 index 699d2a1..ff24076 100644 --- a/src/tests/wenoof_test_ui.f90 +++ b/src/tests/wenoof_test_ui.f90 @@ -171,7 +171,6 @@ function loop_interpolator(self, interpolator) result(again) !< Loop over available interpolators. class(test_ui), intent(in) :: self !< Test UI. character(99), intent(out) :: interpolator !< Interpolator name. - character(99) :: approximation !< Approximation type. logical :: again !< Flag continuing the loop. integer(I_P), save :: i = 0 !< Counter. From 545d0e42ce0004630d13585611bc654c744e04c8 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 14:49:04 +0200 Subject: [PATCH 80/90] fix interpolation coefficients --- .../wenoof_interpolations_int_js.F90 | 487 +++++++++--------- 1 file changed, 247 insertions(+), 240 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 index 5a34c41..ae072e2 100644 --- a/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_interpolations_int_js.F90 @@ -45,6 +45,7 @@ subroutine create(self, constructor) !< Create interpolations. class(interpolations_int_js), intent(inout) :: self !< Interpolations. class(base_object_constructor), intent(in) :: constructor !< Interpolations constructor. + real(RPP), allocatable :: f(:,:) !< Temporary variable. real(RPP) :: prod !< Temporary variable. real(RPP) :: c_sum !< Temporary variable. integer(I_P) :: i, j, k !< Counters. @@ -61,266 +62,267 @@ subroutine create(self, constructor) ! left interface (i-1/2) select case(S) case(2) ! 3rd order - ! cell 0 ; cell 1 - c(0,0)= 0.5_RPP; c(1,0)= 0.5_RPP ! stencil 0 - c(0,1)= 1.5_RPP; c(1,1)= -0.5_RPP ! stencil 1 + ! cell 1 ; cell 0 + c(1,0)= 0.5_RPP; c(0,0)= 0.5_RPP ! stencil 0 + c(1,1)= 1.5_RPP; c(0,1)= -0.5_RPP ! stencil 1 case(3) ! 5th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(2,0)= 3._RPP/8._RPP ! stencil 0 - c(0,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= -1._RPP/8._RPP ! stencil 1 - c(0,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(2,2)= 3._RPP/8._RPP ! stencil 2 + ! cell 2 ; cell 1 ; cell 0 + c(2,0)= -1._RPP/8._RPP; c(1,0)= 3._RPP/4._RPP; c(0,0)= 3._RPP/8._RPP ! stencil 0 + c(2,1)= 3._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(0,1)= -1._RPP/8._RPP ! stencil 1 + c(2,2)= 15._RPP/8._RPP; c(1,2)= -5._RPP/4._RPP; c(0,2)= 3._RPP/8._RPP ! stencil 2 case(4) ! 7th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 1._RPP/16._RPP; c(1,0)= -5._RPP/16._RPP; c(2,0)= 15._RPP/16._RPP; c(3,0)= 5._RPP/16._RPP ! stencil 0 - c(0,1)= -1._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(3,1)= -1._RPP/16._RPP ! stencil 1 - c(0,2)= 5._RPP/16._RPP; c(1,2)= 15._RPP/16._RPP; c(2,2)= -5._RPP/16._RPP; c(3,2)= 1._RPP/16._RPP ! stencil 2 - c(0,3)= 35._RPP/16._RPP; c(1,3)=-35._RPP/16._RPP; c(2,3)= 21._RPP/16._RPP; c(3,3)= -5._RPP/16._RPP ! stencil 3 + ! cell 3 ; cell 2 ; cell 1 ; cell 0 + c(3,0)= 1._RPP/16._RPP; c(2,0)= -5._RPP/16._RPP; c(1,0)= 15._RPP/16._RPP; c(0,0)= 5._RPP/16._RPP ! stencil 0 + c(3,1)= -1._RPP/16._RPP; c(2,1)= 9._RPP/16._RPP; c(1,1)= 9._RPP/16._RPP; c(0,1)= -1._RPP/16._RPP ! stencil 1 + c(3,2)= 5._RPP/16._RPP; c(2,2)= 15._RPP/16._RPP; c(1,2)= -5._RPP/16._RPP; c(0,2)= 1._RPP/16._RPP ! stencil 2 + c(3,3)= 35._RPP/16._RPP; c(2,3)=-35._RPP/16._RPP; c(1,3)= 21._RPP/16._RPP; c(0,3)= -5._RPP/16._RPP ! stencil 3 case(5) ! 9th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -5._RPP/128._RPP; c(1,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(3,0)= 35._RPP/32._RPP ! stencil 0 - c(0,1)= 3._RPP/128._RPP; c(1,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(3,1)= 15._RPP/32._RPP ! stencil 1 - c(0,2)= -5._RPP/128._RPP; c(1,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= -5._RPP/32._RPP ! stencil 2 - c(0,3)= 35._RPP/128._RPP; c(1,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(3,3)= 7._RPP/32._RPP ! stencil 3 - c(0,4)= 315._RPP/128._RPP; c(1,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(3,4)= -45._RPP/32._RPP ! stencil 4 - ! cell 4 - c(4,0)= 35._RPP/128._RPP ! stencil 0 - c(4,1)= -5._RPP/128._RPP ! stencil 1 - c(4,2)= 3._RPP/128._RPP ! stencil 2 - c(4,3)= -5._RPP/128._RPP ! stencil 3 - c(4,4)= 35._RPP/128._RPP ! stencil 4 + ! cell 4 ; cell 3 ; cell 2 ; cell 1 + c(4,0)= -5._RPP/128._RPP; c(3,0)= 7._RPP/32._RPP ; c(2,0)= -35._RPP/64._RPP ; c(1,0)= 35._RPP/32._RPP ! stencil 0 + c(4,1)= 3._RPP/128._RPP; c(3,1)= -5._RPP/32._RPP ; c(2,1)= 45._RPP/64._RPP ; c(1,1)= 15._RPP/32._RPP ! stencil 1 + c(4,2)= -5._RPP/128._RPP; c(3,2)= 15._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(1,2)= -5._RPP/32._RPP ! stencil 2 + c(4,3)= 35._RPP/128._RPP; c(3,3)= 35._RPP/32._RPP ; c(2,3)= -35._RPP/64._RPP ; c(1,3)= 7._RPP/32._RPP ! stencil 3 + c(4,4)= 315._RPP/128._RPP; c(3,4)=-105._RPP/32._RPP ; c(2,4)= 189._RPP/64._RPP ; c(1,4)= -45._RPP/32._RPP ! stencil 4 + ! cell 0 + c(0,0)= 35._RPP/128._RPP ! stencil 0 + c(0,1)= -5._RPP/128._RPP ! stencil 1 + c(0,2)= 3._RPP/128._RPP ! stencil 2 + c(0,3)= -5._RPP/128._RPP ! stencil 3 + c(0,4)= 35._RPP/128._RPP ! stencil 4 case(6) ! 11th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 7._RPP/256._RPP; c(1,0)= -45._RPP/256._RPP; c(2,0)= 63._RPP/128._RPP ! stencil 0 - c(0,1)= -3._RPP/256._RPP; c(1,1)= 21._RPP/256._RPP; c(2,1)= -35._RPP/128._RPP ! stencil 1 - c(0,2)= 3._RPP/256._RPP; c(1,2)= -25._RPP/256._RPP; c(2,2)= 75._RPP/128._RPP ! stencil 2 - c(0,3)= -7._RPP/256._RPP; c(1,3)= 105._RPP/256._RPP; c(2,3)= 105._RPP/128._RPP ! stencil 3 - c(0,4)= 63._RPP/256._RPP; c(1,4)= 315._RPP/256._RPP; c(2,4)= -105._RPP/128._RPP ! stencil 4 - c(0,5)= 693._RPP/256._RPP; c(1,5)=-1155._RPP/256._RPP; c(2,5)= 693._RPP/128._RPP ! stencil 5 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= -105._RPP/128._RPP; c(4,0)= 315._RPP/256._RPP; c(5,0)= 63._RPP/256._RPP ! stencil 0 - c(3,1)= 105._RPP/128._RPP; c(4,1)= 105._RPP/256._RPP; c(5,1)= -7._RPP/256._RPP ! stencil 1 - c(3,2)= 75._RPP/128._RPP; c(4,2)= -25._RPP/256._RPP; c(5,2)= 3._RPP/256._RPP ! stencil 2 - c(3,3)= -35._RPP/128._RPP; c(4,3)= 21._RPP/256._RPP; c(5,3)= -3._RPP/256._RPP ! stencil 3 - c(3,4)= 63._RPP/128._RPP; c(4,4)= -45._RPP/256._RPP; c(5,4)= 7._RPP/256._RPP ! stencil 4 - c(3,5)= -495._RPP/128._RPP; c(4,5)= 385._RPP/256._RPP; c(5,5)= -63._RPP/256._RPP ! stencil 5 + ! cell 5 ; cell 4 ; cell 3 + c(5,0)= 7._RPP/256._RPP; c(4,0)= -45._RPP/256._RPP; c(3,0)= 63._RPP/128._RPP ! stencil 0 + c(5,1)= -3._RPP/256._RPP; c(4,1)= 21._RPP/256._RPP; c(3,1)= -35._RPP/128._RPP ! stencil 1 + c(5,2)= 3._RPP/256._RPP; c(4,2)= -25._RPP/256._RPP; c(3,2)= 75._RPP/128._RPP ! stencil 2 + c(5,3)= -7._RPP/256._RPP; c(4,3)= 105._RPP/256._RPP; c(3,3)= 105._RPP/128._RPP ! stencil 3 + c(5,4)= 63._RPP/256._RPP; c(4,4)= 315._RPP/256._RPP; c(3,4)= -105._RPP/128._RPP ! stencil 4 + c(5,5)= 693._RPP/256._RPP; c(4,5)=-1155._RPP/256._RPP; c(3,5)= 693._RPP/128._RPP ! stencil 5 + ! cell 2 ; cell 1 ; cell 0 + c(2,0)= -105._RPP/128._RPP; c(1,0)= 315._RPP/256._RPP; c(0,0)= 63._RPP/256._RPP ! stencil 0 + c(2,1)= 105._RPP/128._RPP; c(1,1)= 105._RPP/256._RPP; c(0,1)= -7._RPP/256._RPP ! stencil 1 + c(2,2)= 75._RPP/128._RPP; c(1,2)= -25._RPP/256._RPP; c(0,2)= 3._RPP/256._RPP ! stencil 2 + c(2,3)= -35._RPP/128._RPP; c(1,3)= 21._RPP/256._RPP; c(0,3)= -3._RPP/256._RPP ! stencil 3 + c(2,4)= 63._RPP/128._RPP; c(1,4)= -45._RPP/256._RPP; c(0,4)= 7._RPP/256._RPP ! stencil 4 + c(2,5)= -495._RPP/128._RPP; c(1,5)= 385._RPP/256._RPP; c(0,5)= -63._RPP/256._RPP ! stencil 5 case(7) ! 13th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -21._RPP/1024._RPP; c(1,0)= 77._RPP/512._RPP ; c(2,0)= -495._RPP/1024._RPP ! stencil 0 - c(0,1)= 7._RPP/1024._RPP; c(1,1)= -27._RPP/512._RPP ; c(2,1)= 189._RPP/1024._RPP ! stencil 1 - c(0,2)= -5._RPP/1024._RPP; c(1,2)= 21._RPP/512._RPP ; c(2,2)= -175._RPP/1024._RPP ! stencil 2 - c(0,3)= 7._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ; c(2,3)= 525._RPP/1024._RPP ! stencil 3 - c(0,4)= -21._RPP/1024._RPP; c(1,4)= 189._RPP/512._RPP ; c(2,4)= 945._RPP/1024._RPP ! stencil 4 - c(0,5)= 231._RPP/1024._RPP; c(1,5)= 693._RPP/512._RPP ; c(2,5)=-1155._RPP/1024._RPP ! stencil 5 - c(0,6)= 3003._RPP/1024._RPP; c(1,6)=-3003._RPP/512._RPP ; c(2,6)= 9009._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 231._RPP/256._RPP ; c(4,0)=-1155._RPP/1024._RPP; c(5,0)= 693._RPP/512._RPP ! stencil 0 - c(3,1)= -105._RPP/256._RPP ; c(4,1)= 945._RPP/1024._RPP; c(5,1)= 189._RPP/512._RPP ! stencil 1 - c(3,2)= 175._RPP/256._RPP ; c(4,2)= 525._RPP/1024._RPP; c(5,2)= -35._RPP/512._RPP ! stencil 2 - c(3,3)= 175._RPP/256._RPP ; c(4,3)= -175._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ! stencil 3 - c(3,4)= -105._RPP/256._RPP ; c(4,4)= 189._RPP/1024._RPP; c(5,4)= -27._RPP/512._RPP ! stencil 4 - c(3,5)= 231._RPP/256._RPP ; c(4,5)= -495._RPP/1024._RPP; c(5,5)= 77._RPP/512._RPP ! stencil 5 - c(3,6)=-2145._RPP/256._RPP ; c(4,6)= 5005._RPP/1024._RPP; c(5,6)= -819._RPP/512._RPP ! stencil 6 - ! cell 6 - c(6,0)= 231._RPP/1024._RPP ! stencil 0 - c(6,1)= -21._RPP/1024._RPP ! stencil 1 - c(6,2)= 7._RPP/1024._RPP ! stencil 2 - c(6,3)= -5._RPP/1024._RPP ! stencil 3 - c(6,4)= 7._RPP/1024._RPP ! stencil 4 - c(6,5)= -21._RPP/1024._RPP ! stencil 5 - c(6,6)= 231._RPP/1024._RPP ! stencil 6 + ! cell 6 ; cell 5 ; cell 4 + c(6,0)= -21._RPP/1024._RPP; c(5,0)= 77._RPP/512._RPP ; c(4,0)= -495._RPP/1024._RPP ! stencil 0 + c(6,1)= 7._RPP/1024._RPP; c(5,1)= -27._RPP/512._RPP ; c(4,1)= 189._RPP/1024._RPP ! stencil 1 + c(6,2)= -5._RPP/1024._RPP; c(5,2)= 21._RPP/512._RPP ; c(4,2)= -175._RPP/1024._RPP ! stencil 2 + c(6,3)= 7._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ; c(4,3)= 525._RPP/1024._RPP ! stencil 3 + c(6,4)= -21._RPP/1024._RPP; c(5,4)= 189._RPP/512._RPP ; c(4,4)= 945._RPP/1024._RPP ! stencil 4 + c(6,5)= 231._RPP/1024._RPP; c(5,5)= 693._RPP/512._RPP ; c(4,5)=-1155._RPP/1024._RPP ! stencil 5 + c(6,6)= 3003._RPP/1024._RPP; c(5,6)=-3003._RPP/512._RPP ; c(4,6)= 9009._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 2 ; cell 1 + c(3,0)= 231._RPP/256._RPP ; c(2,0)=-1155._RPP/1024._RPP; c(1,0)= 693._RPP/512._RPP ! stencil 0 + c(3,1)= -105._RPP/256._RPP ; c(2,1)= 945._RPP/1024._RPP; c(1,1)= 189._RPP/512._RPP ! stencil 1 + c(3,2)= 175._RPP/256._RPP ; c(2,2)= 525._RPP/1024._RPP; c(1,2)= -35._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(2,3)= -175._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ! stencil 3 + c(3,4)= -105._RPP/256._RPP ; c(2,4)= 189._RPP/1024._RPP; c(1,4)= -27._RPP/512._RPP ! stencil 4 + c(3,5)= 231._RPP/256._RPP ; c(2,5)= -495._RPP/1024._RPP; c(1,5)= 77._RPP/512._RPP ! stencil 5 + c(3,6)=-2145._RPP/256._RPP ; c(2,6)= 5005._RPP/1024._RPP; c(1,6)= -819._RPP/512._RPP ! stencil 6 + ! cell 0 + c(0,0)= 231._RPP/1024._RPP ! stencil 0 + c(0,1)= -21._RPP/1024._RPP ! stencil 1 + c(0,2)= 7._RPP/1024._RPP ! stencil 2 + c(0,3)= -5._RPP/1024._RPP ! stencil 3 + c(0,4)= 7._RPP/1024._RPP ! stencil 4 + c(0,5)= -21._RPP/1024._RPP ! stencil 5 + c(0,6)= 231._RPP/1024._RPP ! stencil 6 case(8) ! 15th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 33._RPP/2048._RPP; c(1,0)= -273._RPP/2048._RPP; c(2,0)= 1001._RPP/2048._RPP ! stencil 0 - c(0,1)= -9._RPP/2048._RPP; c(1,1)= 77._RPP/2048._RPP; c(2,1)= -297._RPP/2048._RPP ! stencil 1 - c(0,2)= 5._RPP/2048._RPP; c(1,2)= -45._RPP/2048._RPP; c(2,2)= 189._RPP/2048._RPP ! stencil 2 - c(0,3)= -5._RPP/2048._RPP; c(1,3)= 49._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 - c(0,4)= 9._RPP/2048._RPP; c(1,4)= -105._RPP/2048._RPP; c(2,4)= 945._RPP/2048._RPP ! stencil 4 - c(0,5)= -33._RPP/2048._RPP; c(1,5)= 693._RPP/2048._RPP; c(2,5)= 2079._RPP/2048._RPP ! stencil 5 - c(0,6)= 429._RPP/2048._RPP; c(1,6)= 3003._RPP/2048._RPP; c(2,6)= -3003._RPP/2048._RPP ! stencil 6 - c(0,7)= 6435._RPP/2048._RPP; c(1,7)=-15015._RPP/2048._RPP; c(2,7)= 27027._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= -2145._RPP/2048._RPP; c(4,0)= 3003._RPP/2048._RPP; c(5,0)= -3003._RPP/2048._RPP ! stencil 0 - c(3,1)= 693._RPP/2048._RPP; c(4,1)= -1155._RPP/2048._RPP; c(5,1)= 2079._RPP/2048._RPP ! stencil 1 - c(3,2)= -525._RPP/2048._RPP; c(4,2)= 1575._RPP/2048._RPP; c(5,2)= 945._RPP/2048._RPP ! stencil 2 - c(3,3)= 1225._RPP/2048._RPP; c(4,3)= 1225._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 - c(3,4)= 1575._RPP/2048._RPP; c(4,4)= -525._RPP/2048._RPP; c(5,4)= 189._RPP/2048._RPP ! stencil 4 - c(3,5)= -1155._RPP/2048._RPP; c(4,5)= 693._RPP/2048._RPP; c(5,5)= -297._RPP/2048._RPP ! stencil 5 - c(3,6)= 3003._RPP/2048._RPP; c(4,6)= -2145._RPP/2048._RPP; c(5,6)= 1001._RPP/2048._RPP ! stencil 6 - c(3,7)=-32175._RPP/2048._RPP; c(4,7)= 25025._RPP/2048._RPP; c(5,7)=-12285._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(6,0)= 3003._RPP/2048._RPP; c(7,0)= 429._RPP/2048._RPP ! stencil 0 - c(6,1)= 693._RPP/2048._RPP; c(7,1)= -33._RPP/2048._RPP ! stencil 1 - c(6,2)= -105._RPP/2048._RPP; c(7,2)= 9._RPP/2048._RPP ! stencil 2 - c(6,3)= 49._RPP/2048._RPP; c(7,3)= -5._RPP/2048._RPP ! stencil 3 - c(6,4)= -45._RPP/2048._RPP; c(7,4)= 5._RPP/2048._RPP ! stencil 4 - c(6,5)= 77._RPP/2048._RPP; c(7,5)= -9._RPP/2048._RPP ! stencil 5 - c(6,6)= -273._RPP/2048._RPP; c(7,6)= 33._RPP/2048._RPP ! stencil 6 - c(6,7)= 3465._RPP/2048._RPP; c(7,7)= -429._RPP/2048._RPP ! stencil 7 + ! cell 7 ; cell 6 ; cell 5 + c(7,0)= 33._RPP/2048._RPP; c(6,0)= -273._RPP/2048._RPP; c(5,0)= 1001._RPP/2048._RPP ! stencil 0 + c(7,1)= -9._RPP/2048._RPP; c(6,1)= 77._RPP/2048._RPP; c(5,1)= -297._RPP/2048._RPP ! stencil 1 + c(7,2)= 5._RPP/2048._RPP; c(6,2)= -45._RPP/2048._RPP; c(5,2)= 189._RPP/2048._RPP ! stencil 2 + c(7,3)= -5._RPP/2048._RPP; c(6,3)= 49._RPP/2048._RPP; c(5,3)= -245._RPP/2048._RPP ! stencil 3 + c(7,4)= 9._RPP/2048._RPP; c(6,4)= -105._RPP/2048._RPP; c(5,4)= 945._RPP/2048._RPP ! stencil 4 + c(7,5)= -33._RPP/2048._RPP; c(6,5)= 693._RPP/2048._RPP; c(5,5)= 2079._RPP/2048._RPP ! stencil 5 + c(7,6)= 429._RPP/2048._RPP; c(6,6)= 3003._RPP/2048._RPP; c(5,6)= -3003._RPP/2048._RPP ! stencil 6 + c(7,7)= 6435._RPP/2048._RPP; c(6,7)=-15015._RPP/2048._RPP; c(5,7)= 27027._RPP/2048._RPP ! stencil 7 + ! cell 4 ; cell 3 ; cell 2 + c(4,0)= -2145._RPP/2048._RPP; c(3,0)= 3003._RPP/2048._RPP; c(2,0)= -3003._RPP/2048._RPP ! stencil 0 + c(4,1)= 693._RPP/2048._RPP; c(3,1)= -1155._RPP/2048._RPP; c(2,1)= 2079._RPP/2048._RPP ! stencil 1 + c(4,2)= -525._RPP/2048._RPP; c(3,2)= 1575._RPP/2048._RPP; c(2,2)= 945._RPP/2048._RPP ! stencil 2 + c(4,3)= 1225._RPP/2048._RPP; c(3,3)= 1225._RPP/2048._RPP; c(2,3)= -245._RPP/2048._RPP ! stencil 3 + c(4,4)= 1575._RPP/2048._RPP; c(3,4)= -525._RPP/2048._RPP; c(2,4)= 189._RPP/2048._RPP ! stencil 4 + c(4,5)= -1155._RPP/2048._RPP; c(3,5)= 693._RPP/2048._RPP; c(2,5)= -297._RPP/2048._RPP ! stencil 5 + c(4,6)= 3003._RPP/2048._RPP; c(3,6)= -2145._RPP/2048._RPP; c(2,6)= 1001._RPP/2048._RPP ! stencil 6 + c(4,7)=-32175._RPP/2048._RPP; c(3,7)= 25025._RPP/2048._RPP; c(2,7)=-12285._RPP/2048._RPP ! stencil 7 + ! cell 1 ; cell 0 + c(1,0)= 3003._RPP/2048._RPP; c(0,0)= 429._RPP/2048._RPP ! stencil 0 + c(1,1)= 693._RPP/2048._RPP; c(0,1)= -33._RPP/2048._RPP ! stencil 1 + c(1,2)= -105._RPP/2048._RPP; c(0,2)= 9._RPP/2048._RPP ! stencil 2 + c(1,3)= 49._RPP/2048._RPP; c(0,3)= -5._RPP/2048._RPP ! stencil 3 + c(1,4)= -45._RPP/2048._RPP; c(0,4)= 5._RPP/2048._RPP ! stencil 4 + c(1,5)= 77._RPP/2048._RPP; c(0,5)= -9._RPP/2048._RPP ! stencil 5 + c(1,6)= -273._RPP/2048._RPP; c(0,6)= 33._RPP/2048._RPP ! stencil 6 + c(1,7)= 3465._RPP/2048._RPP; c(0,7)= -429._RPP/2048._RPP ! stencil 7 case(9) ! 17th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -429._RPP/32768._RPP; c(1,0)= 495._RPP/4096._RPP ; c(2,0)= -4095._RPP/8192._RPP ! stencil 0 - c(0,1)= 99._RPP/32768._RPP; c(1,1)= -117._RPP/4096._RPP ; c(2,1)= 1001._RPP/8192._RPP ! stencil 1 - c(0,2)= -45._RPP/32768._RPP; c(1,2)= 55._RPP/4096._RPP ; c(2,2)= -495._RPP/8192._RPP ! stencil 2 - c(0,3)= 35._RPP/32768._RPP; c(1,3)= -45._RPP/4096._RPP ; c(2,3)= 441._RPP/8192._RPP ! stencil 3 - c(0,4)= -45._RPP/32768._RPP; c(1,4)= 63._RPP/4096._RPP ; c(2,4)= -735._RPP/8192._RPP ! stencil 4 - c(0,5)= 99._RPP/32768._RPP; c(1,5)= -165._RPP/4096._RPP ; c(2,5)= 3465._RPP/8192._RPP ! stencil 5 - c(0,6)= -429._RPP/32768._RPP; c(1,6)= 1287._RPP/4096._RPP ; c(2,6)= 9009._RPP/8192._RPP ! stencil 6 - c(0,7)= 6435._RPP/32768._RPP; c(1,7)= 6435._RPP/4096._RPP ; c(2,7)= -15015._RPP/8192._RPP ! stencil 7 - c(0,8)= 109395._RPP/32768._RPP; c(1,8)= -36465._RPP/4096._RPP ; c(2,8)= 153153._RPP/8192._RPP ! stencil 8 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(5,0)= 9009._RPP/4096._RPP ! stencil 0 - c(3,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(5,1)= -3003._RPP/4096._RPP ! stencil 1 - c(3,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(5,2)= 3465._RPP/4096._RPP ! stencil 2 - c(3,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(5,3)= 2205._RPP/4096._RPP ! stencil 3 - c(3,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= -735._RPP/4096._RPP ! stencil 4 - c(3,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(5,5)= 693._RPP/4096._RPP ! stencil 5 - c(3,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(5,6)= -1287._RPP/4096._RPP ! stencil 6 - c(3,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(5,7)= 5005._RPP/4096._RPP ! stencil 7 - c(3,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(5,8)= -69615._RPP/4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(6,0)= -15015._RPP/8192._RPP ; c(7,0)= 6435._RPP/4096._RPP ; c(8,0)= 6435._RPP/32768._RPP ! stencil 0 - c(6,1)= 9009._RPP/8192._RPP ; c(7,1)= 1287._RPP/4096._RPP ; c(8,1)= -429._RPP/32768._RPP ! stencil 1 - c(6,2)= 3465._RPP/8192._RPP ; c(7,2)= -165._RPP/4096._RPP ; c(8,2)= 99._RPP/32768._RPP ! stencil 2 - c(6,3)= -735._RPP/8192._RPP ; c(7,3)= 63._RPP/4096._RPP ; c(8,3)= -45._RPP/32768._RPP ! stencil 3 - c(6,4)= 441._RPP/8192._RPP ; c(7,4)= -45._RPP/4096._RPP ; c(8,4)= 35._RPP/32768._RPP ! stencil 4 - c(6,5)= -495._RPP/8192._RPP ; c(7,5)= 55._RPP/4096._RPP ; c(8,5)= -45._RPP/32768._RPP ! stencil 5 - c(6,6)= 1001._RPP/8192._RPP ; c(7,6)= -117._RPP/4096._RPP ; c(8,6)= 99._RPP/32768._RPP ! stencil 6 - c(6,7)= -4095._RPP/8192._RPP ; c(7,7)= 495._RPP/4096._RPP ; c(8,7)= -429._RPP/32768._RPP ! stencil 7 - c(6,8)= 58905._RPP/8192._RPP ; c(7,8)= -7293._RPP/4096._RPP ; c(8,8)= 6435._RPP/32768._RPP ! stencil 8 + ! cell 8 ; cell 7 ; cell 6 + c(8,0)= -429._RPP/32768._RPP; c(7,0)= 495._RPP/4096._RPP ; c(6,0)= -4095._RPP/8192._RPP ! stencil 0 + c(8,1)= 99._RPP/32768._RPP; c(7,1)= -117._RPP/4096._RPP ; c(6,1)= 1001._RPP/8192._RPP ! stencil 1 + c(8,2)= -45._RPP/32768._RPP; c(7,2)= 55._RPP/4096._RPP ; c(6,2)= -495._RPP/8192._RPP ! stencil 2 + c(8,3)= 35._RPP/32768._RPP; c(7,3)= -45._RPP/4096._RPP ; c(6,3)= 441._RPP/8192._RPP ! stencil 3 + c(8,4)= -45._RPP/32768._RPP; c(7,4)= 63._RPP/4096._RPP ; c(6,4)= -735._RPP/8192._RPP ! stencil 4 + c(8,5)= 99._RPP/32768._RPP; c(7,5)= -165._RPP/4096._RPP ; c(6,5)= 3465._RPP/8192._RPP ! stencil 5 + c(8,6)= -429._RPP/32768._RPP; c(7,6)= 1287._RPP/4096._RPP ; c(6,6)= 9009._RPP/8192._RPP ! stencil 6 + c(8,7)= 6435._RPP/32768._RPP; c(7,7)= 6435._RPP/4096._RPP ; c(6,7)= -15015._RPP/8192._RPP ! stencil 7 + c(8,8)= 109395._RPP/32768._RPP; c(7,8)= -36465._RPP/4096._RPP ; c(6,8)= 153153._RPP/8192._RPP ! stencil 8 + ! cell 5 ; cell 4 ; cell 3 + c(5,0)= 5005._RPP/4096._RPP ; c(4,0)= -32175._RPP/16384._RPP; c(3,0)= 9009._RPP/4096._RPP ! stencil 0 + c(5,1)= -1287._RPP/4096._RPP ; c(4,1)= 9009._RPP/16384._RPP; c(3,1)= -3003._RPP/4096._RPP ! stencil 1 + c(5,2)= 693._RPP/4096._RPP ; c(4,2)= -5775._RPP/16384._RPP; c(3,2)= 3465._RPP/4096._RPP ! stencil 2 + c(5,3)= -735._RPP/4096._RPP ; c(4,3)= 11025._RPP/16384._RPP; c(3,3)= 2205._RPP/4096._RPP ! stencil 3 + c(5,4)= 2205._RPP/4096._RPP ; c(4,4)= 11025._RPP/16384._RPP; c(3,4)= -735._RPP/4096._RPP ! stencil 4 + c(5,5)= 3465._RPP/4096._RPP ; c(4,5)= -5775._RPP/16384._RPP; c(3,5)= 693._RPP/4096._RPP ! stencil 5 + c(5,6)= -3003._RPP/4096._RPP ; c(4,6)= 9009._RPP/16384._RPP; c(3,6)= -1287._RPP/4096._RPP ! stencil 6 + c(5,7)= 9009._RPP/4096._RPP ; c(4,7)= -32175._RPP/16384._RPP; c(3,7)= 5005._RPP/4096._RPP ! stencil 7 + c(5,8)=-109395._RPP/4096._RPP ; c(4,8)= 425425._RPP/16384._RPP; c(3,8)= -69615._RPP/4096._RPP ! stencil 8 + ! cell 2 ; cell 1 ; cell 0 + c(2,0)= -15015._RPP/8192._RPP ; c(1,0)= 6435._RPP/4096._RPP ; c(0,0)= 6435._RPP/32768._RPP ! stencil 0 + c(2,1)= 9009._RPP/8192._RPP ; c(1,1)= 1287._RPP/4096._RPP ; c(0,1)= -429._RPP/32768._RPP ! stencil 1 + c(2,2)= 3465._RPP/8192._RPP ; c(1,2)= -165._RPP/4096._RPP ; c(0,2)= 99._RPP/32768._RPP ! stencil 2 + c(2,3)= -735._RPP/8192._RPP ; c(1,3)= 63._RPP/4096._RPP ; c(0,3)= -45._RPP/32768._RPP ! stencil 3 + c(2,4)= 441._RPP/8192._RPP ; c(1,4)= -45._RPP/4096._RPP ; c(0,4)= 35._RPP/32768._RPP ! stencil 4 + c(2,5)= -495._RPP/8192._RPP ; c(1,5)= 55._RPP/4096._RPP ; c(0,5)= -45._RPP/32768._RPP ! stencil 5 + c(2,6)= 1001._RPP/8192._RPP ; c(1,6)= -117._RPP/4096._RPP ; c(0,6)= 99._RPP/32768._RPP ! stencil 6 + c(2,7)= -4095._RPP/8192._RPP ; c(1,7)= 495._RPP/4096._RPP ; c(0,7)= -429._RPP/32768._RPP ! stencil 7 + c(2,8)= 58905._RPP/8192._RPP ; c(1,8)= -7293._RPP/4096._RPP ; c(0,8)= 6435._RPP/32768._RPP ! stencil 8 endselect elseif(x_target==0.5_RPP) then ! right interface (i+1/2) select case(self%S) case(2) ! 3rd order - ! cell 0 ; cell 1 - c(0,0)= -0.5_RPP; c(1,0)= 1.5_RPP ! stencil 0 - c(0,1)= 0.5_RPP; c(1,1)= 0.5_RPP ! stencil 1 + ! cell 1 ; cell 0 + c(1,0)= -0.5_RPP; c(0,0)= 1.5_RPP ! stencil 0 + c(1,1)= 0.5_RPP; c(0,1)= 0.5_RPP ! stencil 1 case(3) ! 5th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(2,0)= 15._RPP/8._RPP ! stencil 0 - c(0,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(2,1)= 3._RPP/8._RPP ! stencil 1 - c(0,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(2,2)= -1._RPP/8._RPP ! stencil 2 + ! cell 2 ; cell 1 ; cell 0 + c(2,0)= 3._RPP/8._RPP; c(1,0)= -5._RPP/4._RPP; c(0,0)= 15._RPP/8._RPP ! stencil 0 + c(2,1)= -1._RPP/8._RPP; c(1,1)= 3._RPP/4._RPP; c(0,1)= 3._RPP/8._RPP ! stencil 1 + c(2,2)= 3._RPP/8._RPP; c(1,2)= 3._RPP/4._RPP; c(0,2)= -1._RPP/8._RPP ! stencil 2 case(4) ! 7th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= -5._RPP/16._RPP; c(1,0)= 21._RPP/16._RPP; c(2,0)=-35._RPP/16._RPP; c(3,0)= 35._RPP/16._RPP ! stencil 0 - c(0,1)= 1._RPP/16._RPP; c(1,1)= -5._RPP/16._RPP; c(2,1)= 15._RPP/16._RPP; c(3,1)= 5._RPP/16._RPP ! stencil 1 - c(0,2)= -1._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(3,2)= -1._RPP/16._RPP ! stencil 2 - c(0,3)= 5._RPP/16._RPP; c(1,3)= 15._RPP/16._RPP; c(2,3)= -5._RPP/16._RPP; c(3,3)= 1._RPP/16._RPP ! stencil 3 + ! cell 3 ; cell 2 ; cell 1 ; cell 0 + c(3,0)= -5._RPP/16._RPP; c(2,0)= 21._RPP/16._RPP; c(1,0)=-35._RPP/16._RPP; c(0,0)= 35._RPP/16._RPP ! stencil 0 + c(3,1)= 1._RPP/16._RPP; c(2,1)= -5._RPP/16._RPP; c(1,1)= 15._RPP/16._RPP; c(0,1)= 5._RPP/16._RPP ! stencil 1 + c(3,2)= -1._RPP/16._RPP; c(2,2)= 9._RPP/16._RPP; c(1,2)= 9._RPP/16._RPP; c(0,2)= -1._RPP/16._RPP ! stencil 2 + c(3,3)= 5._RPP/16._RPP; c(2,3)= 15._RPP/16._RPP; c(1,3)= -5._RPP/16._RPP; c(0,3)= 1._RPP/16._RPP ! stencil 3 case(5) ! 9th order - ! cell 0 ; cell 1 ; cell 2 ; cell 3 - c(0,0)= 35._RPP/128._RPP; c(1,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(3,0)=-105._RPP/32._RPP ! stencil 0 - c(0,1)= -5._RPP/128._RPP; c(1,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(3,1)= 35._RPP/32._RPP ! stencil 1 - c(0,2)= 3._RPP/128._RPP; c(1,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(3,2)= 15._RPP/32._RPP ! stencil 2 - c(0,3)= -5._RPP/128._RPP; c(1,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(3,3)= -5._RPP/32._RPP ! stencil 3 - c(0,4)= 35._RPP/128._RPP; c(1,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(3,4)= 7._RPP/32._RPP ! stencil 4 - ! cell 4 - c(4,0)= 315._RPP/128._RPP ! stencil 0 - c(4,1)= 35._RPP/128._RPP ! stencil 1 - c(4,2)= -5._RPP/128._RPP ! stencil 2 - c(4,3)= 3._RPP/128._RPP ! stencil 3 - c(4,4)= -5._RPP/128._RPP ! stencil 4 + ! cell 4 ; cell 3 ; cell 2 ; cell 1 + c(4,0)= 35._RPP/128._RPP; c(3,0)= -45._RPP/32._RPP ; c(2,0)= 189._RPP/64._RPP ; c(1,0)=-105._RPP/32._RPP ! stencil 0 + c(4,1)= -5._RPP/128._RPP; c(3,1)= 7._RPP/32._RPP ; c(2,1)= -35._RPP/64._RPP ; c(1,1)= 35._RPP/32._RPP ! stencil 1 + c(4,2)= 3._RPP/128._RPP; c(3,2)= -5._RPP/32._RPP ; c(2,2)= 45._RPP/64._RPP ; c(1,2)= 15._RPP/32._RPP ! stencil 2 + c(4,3)= -5._RPP/128._RPP; c(3,3)= 15._RPP/32._RPP ; c(2,3)= 45._RPP/64._RPP ; c(1,3)= -5._RPP/32._RPP ! stencil 3 + c(4,4)= 35._RPP/128._RPP; c(3,4)= 35._RPP/32._RPP ; c(2,4)= -35._RPP/64._RPP ; c(1,4)= 7._RPP/32._RPP ! stencil 4 + ! cell 0 + c(0,0)= 315._RPP/128._RPP ! stencil 0 + c(0,1)= 35._RPP/128._RPP ! stencil 1 + c(0,2)= -5._RPP/128._RPP ! stencil 2 + c(0,3)= 3._RPP/128._RPP ! stencil 3 + c(0,4)= -5._RPP/128._RPP ! stencil 4 case(6) ! 11th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -63._RPP/256._RPP; c(1,0)= 385._RPP/256._RPP; c(2,0)= -495._RPP/128._RPP ! stencil 0 - c(0,1)= 7._RPP/256._RPP; c(1,1)= -45._RPP/256._RPP; c(2,1)= 63._RPP/128._RPP ! stencil 1 - c(0,2)= -3._RPP/256._RPP; c(1,2)= 21._RPP/256._RPP; c(2,2)= -35._RPP/128._RPP ! stencil 2 - c(0,3)= 3._RPP/256._RPP; c(1,3)= -25._RPP/256._RPP; c(2,3)= 75._RPP/128._RPP ! stencil 3 - c(0,4)= -7._RPP/256._RPP; c(1,4)= 105._RPP/256._RPP; c(2,4)= 105._RPP/128._RPP ! stencil 4 - c(0,5)= 63._RPP/256._RPP; c(1,5)= 315._RPP/256._RPP; c(2,5)= -105._RPP/128._RPP ! stencil 5 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 693._RPP/128._RPP; c(4,0)=-1155._RPP/256._RPP; c(5,0)= 693._RPP/256._RPP ! stencil 0 - c(3,1)= -105._RPP/128._RPP; c(4,1)= 315._RPP/256._RPP; c(5,1)= 63._RPP/256._RPP ! stencil 1 - c(3,2)= 105._RPP/128._RPP; c(4,2)= 105._RPP/256._RPP; c(5,2)= -7._RPP/256._RPP ! stencil 2 - c(3,3)= 75._RPP/128._RPP; c(4,3)= -25._RPP/256._RPP; c(5,3)= 3._RPP/256._RPP ! stencil 3 - c(3,4)= -35._RPP/128._RPP; c(4,4)= 21._RPP/256._RPP; c(5,4)= -3._RPP/256._RPP ! stencil 4 - c(3,5)= 63._RPP/128._RPP; c(4,5)= -45._RPP/256._RPP; c(5,5)= 7._RPP/256._RPP ! stencil 5 + ! cell 5 ; cell 4 ; cell 3 + c(5,0)= -63._RPP/256._RPP; c(4,0)= 385._RPP/256._RPP; c(3,0)= -495._RPP/128._RPP ! stencil 0 + c(5,1)= 7._RPP/256._RPP; c(4,1)= -45._RPP/256._RPP; c(3,1)= 63._RPP/128._RPP ! stencil 1 + c(5,2)= -3._RPP/256._RPP; c(4,2)= 21._RPP/256._RPP; c(3,2)= -35._RPP/128._RPP ! stencil 2 + c(5,3)= 3._RPP/256._RPP; c(4,3)= -25._RPP/256._RPP; c(3,3)= 75._RPP/128._RPP ! stencil 3 + c(5,4)= -7._RPP/256._RPP; c(4,4)= 105._RPP/256._RPP; c(3,4)= 105._RPP/128._RPP ! stencil 4 + c(5,5)= 63._RPP/256._RPP; c(4,5)= 315._RPP/256._RPP; c(3,5)= -105._RPP/128._RPP ! stencil 5 + ! cell 2 ; cell 1 ; cell 0 + c(2,0)= 693._RPP/128._RPP; c(1,0)=-1155._RPP/256._RPP; c(0,0)= 693._RPP/256._RPP ! stencil 0 + c(2,1)= -105._RPP/128._RPP; c(1,1)= 315._RPP/256._RPP; c(0,1)= 63._RPP/256._RPP ! stencil 1 + c(2,2)= 105._RPP/128._RPP; c(1,2)= 105._RPP/256._RPP; c(0,2)= -7._RPP/256._RPP ! stencil 2 + c(2,3)= 75._RPP/128._RPP; c(1,3)= -25._RPP/256._RPP; c(0,3)= 3._RPP/256._RPP ! stencil 3 + c(2,4)= -35._RPP/128._RPP; c(1,4)= 21._RPP/256._RPP; c(0,4)= -3._RPP/256._RPP ! stencil 4 + c(2,5)= 63._RPP/128._RPP; c(1,5)= -45._RPP/256._RPP; c(0,5)= 7._RPP/256._RPP ! stencil 5 case(7) ! 13th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 231._RPP/1024._RPP; c(1,0)= -819._RPP/512._RPP ; c(2,0)= 5005._RPP/1024._RPP ! stencil 0 - c(0,1)= -21._RPP/1024._RPP; c(1,1)= 77._RPP/512._RPP ; c(2,1)= -495._RPP/1024._RPP ! stencil 1 - c(0,2)= 7._RPP/1024._RPP; c(1,2)= -27._RPP/512._RPP ; c(2,2)= 189._RPP/1024._RPP ! stencil 2 - c(0,3)= -5._RPP/1024._RPP; c(1,3)= 21._RPP/512._RPP ; c(2,3)= -175._RPP/1024._RPP ! stencil 3 - c(0,4)= 7._RPP/1024._RPP; c(1,4)= -35._RPP/512._RPP ; c(2,4)= 525._RPP/1024._RPP ! stencil 4 - c(0,5)= -21._RPP/1024._RPP; c(1,5)= 189._RPP/512._RPP ; c(2,5)= 945._RPP/1024._RPP ! stencil 5 - c(0,6)= 231._RPP/1024._RPP; c(1,6)= 693._RPP/512._RPP ; c(2,6)=-1155._RPP/1024._RPP ! stencil 6 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)=-2145._RPP/256._RPP ; c(4,0)= 9009._RPP/1024._RPP; c(5,0)=-3003._RPP/512._RPP ! stencil 0 - c(3,1)= 231._RPP/256._RPP ; c(4,1)=-1155._RPP/1024._RPP; c(5,1)= 693._RPP/512._RPP ! stencil 1 - c(3,2)= -105._RPP/256._RPP ; c(4,2)= 945._RPP/1024._RPP; c(5,2)= 189._RPP/512._RPP ! stencil 2 - c(3,3)= 175._RPP/256._RPP ; c(4,3)= 525._RPP/1024._RPP; c(5,3)= -35._RPP/512._RPP ! stencil 3 - c(3,4)= 175._RPP/256._RPP ; c(4,4)= -175._RPP/1024._RPP; c(5,4)= 21._RPP/512._RPP ! stencil 4 - c(3,5)= -105._RPP/256._RPP ; c(4,5)= 189._RPP/1024._RPP; c(5,5)= -27._RPP/512._RPP ! stencil 5 - c(3,6)= 231._RPP/256._RPP ; c(4,6)= -495._RPP/1024._RPP; c(5,6)= 77._RPP/512._RPP ! stencil 6 - ! cell 6 - c(6,0)= 3003._RPP/1024._RPP ! stencil 0 - c(6,1)= 231._RPP/1024._RPP ! stencil 1 - c(6,2)= -21._RPP/1024._RPP ! stencil 2 - c(6,3)= 7._RPP/1024._RPP ! stencil 3 - c(6,4)= -5._RPP/1024._RPP ! stencil 4 - c(6,5)= 7._RPP/1024._RPP ! stencil 5 - c(6,6)= -21._RPP/1024._RPP ! stencil 6 + ! cell 6 ; cell 5 ; cell 4 + c(6,0)= 231._RPP/1024._RPP; c(5,0)= -819._RPP/512._RPP ; c(4,0)= 5005._RPP/1024._RPP ! stencil 0 + c(6,1)= -21._RPP/1024._RPP; c(5,1)= 77._RPP/512._RPP ; c(4,1)= -495._RPP/1024._RPP ! stencil 1 + c(6,2)= 7._RPP/1024._RPP; c(5,2)= -27._RPP/512._RPP ; c(4,2)= 189._RPP/1024._RPP ! stencil 2 + c(6,3)= -5._RPP/1024._RPP; c(5,3)= 21._RPP/512._RPP ; c(4,3)= -175._RPP/1024._RPP ! stencil 3 + c(6,4)= 7._RPP/1024._RPP; c(5,4)= -35._RPP/512._RPP ; c(4,4)= 525._RPP/1024._RPP ! stencil 4 + c(6,5)= -21._RPP/1024._RPP; c(5,5)= 189._RPP/512._RPP ; c(4,5)= 945._RPP/1024._RPP ! stencil 5 + c(6,6)= 231._RPP/1024._RPP; c(5,6)= 693._RPP/512._RPP ; c(4,6)=-1155._RPP/1024._RPP ! stencil 6 + ! cell 3 ; cell 2 ; cell 1 + c(3,0)=-2145._RPP/256._RPP ; c(2,0)= 9009._RPP/1024._RPP; c(1,0)=-3003._RPP/512._RPP ! stencil 0 + c(3,1)= 231._RPP/256._RPP ; c(2,1)=-1155._RPP/1024._RPP; c(1,1)= 693._RPP/512._RPP ! stencil 1 + c(3,2)= -105._RPP/256._RPP ; c(2,2)= 945._RPP/1024._RPP; c(1,2)= 189._RPP/512._RPP ! stencil 2 + c(3,3)= 175._RPP/256._RPP ; c(2,3)= 525._RPP/1024._RPP; c(1,3)= -35._RPP/512._RPP ! stencil 3 + c(3,4)= 175._RPP/256._RPP ; c(2,4)= -175._RPP/1024._RPP; c(1,4)= 21._RPP/512._RPP ! stencil 4 + c(3,5)= -105._RPP/256._RPP ; c(2,5)= 189._RPP/1024._RPP; c(1,5)= -27._RPP/512._RPP ! stencil 5 + c(3,6)= 231._RPP/256._RPP ; c(2,6)= -495._RPP/1024._RPP; c(1,6)= 77._RPP/512._RPP ! stencil 6 + ! cell 0 + c(0,0)= 3003._RPP/1024._RPP ! stencil 0 + c(0,1)= 231._RPP/1024._RPP ! stencil 1 + c(0,2)= -21._RPP/1024._RPP ! stencil 2 + c(0,3)= 7._RPP/1024._RPP ! stencil 3 + c(0,4)= -5._RPP/1024._RPP ! stencil 4 + c(0,5)= 7._RPP/1024._RPP ! stencil 5 + c(0,6)= -21._RPP/1024._RPP ! stencil 6 case(8) ! 15th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= -429._RPP/2048._RPP; c(1,0)= 3465._RPP/2048._RPP; c(2,0)=-12285._RPP/2048._RPP ! stencil 0 - c(0,1)= 33._RPP/2048._RPP; c(1,1)= -273._RPP/2048._RPP; c(2,1)= 1001._RPP/2048._RPP ! stencil 1 - c(0,2)= -9._RPP/2048._RPP; c(1,2)= 77._RPP/2048._RPP; c(2,2)= -297._RPP/2048._RPP ! stencil 2 - c(0,3)= 5._RPP/2048._RPP; c(1,3)= -45._RPP/2048._RPP; c(2,3)= 189._RPP/2048._RPP ! stencil 3 - c(0,4)= -5._RPP/2048._RPP; c(1,4)= 49._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 - c(0,5)= 9._RPP/2048._RPP; c(1,5)= -105._RPP/2048._RPP; c(2,5)= 945._RPP/2048._RPP ! stencil 5 - c(0,6)= -33._RPP/2048._RPP; c(1,6)= 693._RPP/2048._RPP; c(2,6)= 2079._RPP/2048._RPP ! stencil 6 - c(0,7)= 429._RPP/2048._RPP; c(1,7)= 3003._RPP/2048._RPP; c(2,7)= -3003._RPP/2048._RPP ! stencil 7 - ! cell 3 ; cell 4 ; cell 5 - c(3,0)= 25025._RPP/2048._RPP; c(4,0)=-32175._RPP/2048._RPP; c(5,0)= 27027._RPP/2048._RPP ! stencil 0 - c(3,1)= -2145._RPP/2048._RPP; c(4,1)= 3003._RPP/2048._RPP; c(5,1)= -3003._RPP/2048._RPP ! stencil 1 - c(3,2)= 693._RPP/2048._RPP; c(4,2)= -1155._RPP/2048._RPP; c(5,2)= 2079._RPP/2048._RPP ! stencil 2 - c(3,3)= -525._RPP/2048._RPP; c(4,3)= 1575._RPP/2048._RPP; c(5,3)= 945._RPP/2048._RPP ! stencil 3 - c(3,4)= 1225._RPP/2048._RPP; c(4,4)= 1225._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 - c(3,5)= 1575._RPP/2048._RPP; c(4,5)= -525._RPP/2048._RPP; c(5,5)= 189._RPP/2048._RPP ! stencil 5 - c(3,6)= -1155._RPP/2048._RPP; c(4,6)= 693._RPP/2048._RPP; c(5,6)= -297._RPP/2048._RPP ! stencil 6 - c(3,7)= 3003._RPP/2048._RPP; c(4,7)= -2145._RPP/2048._RPP; c(5,7)= 1001._RPP/2048._RPP ! stencil 7 - ! cell 6 ; cell 7 - c(6,0)=-15015._RPP/2048._RPP; c(7,0)= 6435._RPP/2048._RPP ! stencil 0 - c(6,1)= 3003._RPP/2048._RPP; c(7,1)= 429._RPP/2048._RPP ! stencil 1 - c(6,2)= 693._RPP/2048._RPP; c(7,2)= -33._RPP/2048._RPP ! stencil 2 - c(6,3)= -105._RPP/2048._RPP; c(7,3)= 9._RPP/2048._RPP ! stencil 3 - c(6,4)= 49._RPP/2048._RPP; c(7,4)= -5._RPP/2048._RPP ! stencil 4 - c(6,5)= -45._RPP/2048._RPP; c(7,5)= 5._RPP/2048._RPP ! stencil 5 - c(6,6)= 77._RPP/2048._RPP; c(7,6)= -9._RPP/2048._RPP ! stencil 6 - c(6,7)= -273._RPP/2048._RPP; c(7,7)= 33._RPP/2048._RPP ! stencil 7 + ! cell 7 ; cell 6 ; cell 5 + c(7,0)= -429._RPP/2048._RPP; c(6,0)= 3465._RPP/2048._RPP; c(5,0)=-12285._RPP/2048._RPP ! stencil 0 + c(7,1)= 33._RPP/2048._RPP; c(6,1)= -273._RPP/2048._RPP; c(5,1)= 1001._RPP/2048._RPP ! stencil 1 + c(7,2)= -9._RPP/2048._RPP; c(6,2)= 77._RPP/2048._RPP; c(5,2)= -297._RPP/2048._RPP ! stencil 2 + c(7,3)= 5._RPP/2048._RPP; c(6,3)= -45._RPP/2048._RPP; c(5,3)= 189._RPP/2048._RPP ! stencil 3 + c(7,4)= -5._RPP/2048._RPP; c(6,4)= 49._RPP/2048._RPP; c(5,4)= -245._RPP/2048._RPP ! stencil 4 + c(7,5)= 9._RPP/2048._RPP; c(6,5)= -105._RPP/2048._RPP; c(5,5)= 945._RPP/2048._RPP ! stencil 5 + c(7,6)= -33._RPP/2048._RPP; c(6,6)= 693._RPP/2048._RPP; c(5,6)= 2079._RPP/2048._RPP ! stencil 6 + c(7,7)= 429._RPP/2048._RPP; c(6,7)= 3003._RPP/2048._RPP; c(5,7)= -3003._RPP/2048._RPP ! stencil 7 + ! cell 4 ; cell 3 ; cell 2 + c(4,0)= 25025._RPP/2048._RPP; c(3,0)=-32175._RPP/2048._RPP; c(2,0)= 27027._RPP/2048._RPP ! stencil 0 + c(4,1)= -2145._RPP/2048._RPP; c(3,1)= 3003._RPP/2048._RPP; c(2,1)= -3003._RPP/2048._RPP ! stencil 1 + c(4,2)= 693._RPP/2048._RPP; c(3,2)= -1155._RPP/2048._RPP; c(2,2)= 2079._RPP/2048._RPP ! stencil 2 + c(4,3)= -525._RPP/2048._RPP; c(3,3)= 1575._RPP/2048._RPP; c(2,3)= 945._RPP/2048._RPP ! stencil 3 + c(4,4)= 1225._RPP/2048._RPP; c(3,4)= 1225._RPP/2048._RPP; c(2,4)= -245._RPP/2048._RPP ! stencil 4 + c(4,5)= 1575._RPP/2048._RPP; c(3,5)= -525._RPP/2048._RPP; c(2,5)= 189._RPP/2048._RPP ! stencil 5 + c(4,6)= -1155._RPP/2048._RPP; c(3,6)= 693._RPP/2048._RPP; c(2,6)= -297._RPP/2048._RPP ! stencil 6 + c(4,7)= 3003._RPP/2048._RPP; c(3,7)= -2145._RPP/2048._RPP; c(2,7)= 1001._RPP/2048._RPP ! stencil 7 + ! cell 1 ; cell 0 + c(1,0)=-15015._RPP/2048._RPP; c(0,0)= 6435._RPP/2048._RPP ! stencil 0 + c(1,1)= 3003._RPP/2048._RPP; c(0,1)= 429._RPP/2048._RPP ! stencil 1 + c(1,2)= 693._RPP/2048._RPP; c(0,2)= -33._RPP/2048._RPP ! stencil 2 + c(1,3)= -105._RPP/2048._RPP; c(0,3)= 9._RPP/2048._RPP ! stencil 3 + c(1,4)= 49._RPP/2048._RPP; c(0,4)= -5._RPP/2048._RPP ! stencil 4 + c(1,5)= -45._RPP/2048._RPP; c(0,5)= 5._RPP/2048._RPP ! stencil 5 + c(1,6)= 77._RPP/2048._RPP; c(0,6)= -9._RPP/2048._RPP ! stencil 6 + c(1,7)= -273._RPP/2048._RPP; c(0,7)= 33._RPP/2048._RPP ! stencil 7 case(9) ! 17th order - ! cell 0 ; cell 1 ; cell 2 - c(0,0)= 6435._RPP/32768._RPP; c(1,0)= -7293._RPP/ 4096._RPP; c(2,0)= 58905._RPP/ 8192._RPP ! stencil 0 - c(0,1)= -429._RPP/32768._RPP; c(1,1)= 495._RPP/ 4096._RPP; c(2,1)= -4095._RPP/ 8192._RPP ! stencil 1 - c(0,2)= 99._RPP/32768._RPP; c(1,2)= -117._RPP/ 4096._RPP; c(2,2)= 1001._RPP/ 8192._RPP ! stencil 2 - c(0,3)= -45._RPP/32768._RPP; c(1,3)= 55._RPP/ 4096._RPP; c(2,3)= -495._RPP/ 8192._RPP ! stencil 3 - c(0,4)= 35._RPP/32768._RPP; c(1,4)= -45._RPP/ 4096._RPP; c(2,4)= 441._RPP/ 8192._RPP ! stencil 4 - c(0,5)= -45._RPP/32768._RPP; c(1,5)= 63._RPP/ 4096._RPP; c(2,5)= -735._RPP/ 8192._RPP ! stencil 5 - c(0,6)= 99._RPP/32768._RPP; c(1,6)= -165._RPP/ 4096._RPP; c(2,6)= 3465._RPP/ 8192._RPP ! stencil 6 - c(0,7)= -429._RPP/32768._RPP; c(1,7)= 1287._RPP/ 4096._RPP; c(2,7)= 9009._RPP/ 8192._RPP ! stencil 7 - c(0,8)= 6435._RPP/32768._RPP; c(1,8)= 6435._RPP/ 4096._RPP; c(2,8)= -15015._RPP/ 8192._RPP ! stencil 8 - ! cell 3 ; ! cell 4 ; cell 5 - c(3,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(5,0)=-109395._RPP/ 4096._RPP ! stencil 0 - c(3,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(5,1)= 9009._RPP/ 4096._RPP ! stencil 1 - c(3,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(5,2)= -3003._RPP/ 4096._RPP ! stencil 2 - c(3,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(5,3)= 3465._RPP/ 4096._RPP ! stencil 3 - c(3,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(5,4)= 2205._RPP/ 4096._RPP ! stencil 4 - c(3,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(5,5)= -735._RPP/ 4096._RPP ! stencil 5 - c(3,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(5,6)= 693._RPP/ 4096._RPP ! stencil 6 - c(3,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(5,7)= -1287._RPP/ 4096._RPP ! stencil 7 - c(3,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(5,8)= 5005._RPP/ 4096._RPP ! stencil 8 - ! cell 6 ; cell 7 ; cell 8 - c(6,0)= 153153._RPP/ 8192._RPP; c(7,0)= -36465._RPP/ 4096._RPP; c(8,0)= 109395._RPP/32768._RPP ! stencil 0 - c(6,1)= -15015._RPP/ 8192._RPP; c(7,1)= 6435._RPP/ 4096._RPP; c(8,1)= 6435._RPP/32768._RPP ! stencil 1 - c(6,2)= 9009._RPP/ 8192._RPP; c(7,2)= 1287._RPP/ 4096._RPP; c(8,2)= -429._RPP/32768._RPP ! stencil 2 - c(6,3)= 3465._RPP/ 8192._RPP; c(7,3)= -165._RPP/ 4096._RPP; c(8,3)= 99._RPP/32768._RPP ! stencil 3 - c(6,4)= -735._RPP/ 8192._RPP; c(7,4)= 63._RPP/ 4096._RPP; c(8,4)= -45._RPP/32768._RPP ! stencil 4 - c(6,5)= 441._RPP/ 8192._RPP; c(7,5)= -45._RPP/ 4096._RPP; c(8,5)= 35._RPP/32768._RPP ! stencil 5 - c(6,6)= -495._RPP/ 8192._RPP; c(7,6)= 55._RPP/ 4096._RPP; c(8,6)= -45._RPP/32768._RPP ! stencil 6 - c(6,7)= 1001._RPP/ 8192._RPP; c(7,7)= -117._RPP/ 4096._RPP; c(8,7)= 99._RPP/32768._RPP ! stencil 7 - c(6,8)= -4095._RPP/ 8192._RPP; c(7,8)= 495._RPP/ 4096._RPP; c(8,8)= -429._RPP/32768._RPP ! stencil 8 + ! cell 8 ; cell 7 ; cell 6 + c(8,0)= 6435._RPP/32768._RPP; c(7,0)= -7293._RPP/ 4096._RPP; c(6,0)= 58905._RPP/ 8192._RPP ! stencil 0 + c(8,1)= -429._RPP/32768._RPP; c(7,1)= 495._RPP/ 4096._RPP; c(6,1)= -4095._RPP/ 8192._RPP ! stencil 1 + c(8,2)= 99._RPP/32768._RPP; c(7,2)= -117._RPP/ 4096._RPP; c(6,2)= 1001._RPP/ 8192._RPP ! stencil 2 + c(8,3)= -45._RPP/32768._RPP; c(7,3)= 55._RPP/ 4096._RPP; c(6,3)= -495._RPP/ 8192._RPP ! stencil 3 + c(8,4)= 35._RPP/32768._RPP; c(7,4)= -45._RPP/ 4096._RPP; c(6,4)= 441._RPP/ 8192._RPP ! stencil 4 + c(8,5)= -45._RPP/32768._RPP; c(7,5)= 63._RPP/ 4096._RPP; c(6,5)= -735._RPP/ 8192._RPP ! stencil 5 + c(8,6)= 99._RPP/32768._RPP; c(7,6)= -165._RPP/ 4096._RPP; c(6,6)= 3465._RPP/ 8192._RPP ! stencil 6 + c(8,7)= -429._RPP/32768._RPP; c(7,7)= 1287._RPP/ 4096._RPP; c(6,7)= 9009._RPP/ 8192._RPP ! stencil 7 + c(8,8)= 6435._RPP/32768._RPP; c(7,8)= 6435._RPP/ 4096._RPP; c(6,8)= -15015._RPP/ 8192._RPP ! stencil 8 + ! cell 5 ; ! cell 4 ; cell 3 + c(5,0)= -69615._RPP/ 4096._RPP; c(4,0)= 425425._RPP/16384._RPP; c(3,0)=-109395._RPP/ 4096._RPP ! stencil 0 + c(5,1)= 5005._RPP/ 4096._RPP; c(4,1)= -32175._RPP/16384._RPP; c(3,1)= 9009._RPP/ 4096._RPP ! stencil 1 + c(5,2)= -1287._RPP/ 4096._RPP; c(4,2)= 9009._RPP/16384._RPP; c(3,2)= -3003._RPP/ 4096._RPP ! stencil 2 + c(5,3)= 693._RPP/ 4096._RPP; c(4,3)= -5775._RPP/16384._RPP; c(3,3)= 3465._RPP/ 4096._RPP ! stencil 3 + c(5,4)= -735._RPP/ 4096._RPP; c(4,4)= 11025._RPP/16384._RPP; c(3,4)= 2205._RPP/ 4096._RPP ! stencil 4 + c(5,5)= 2205._RPP/ 4096._RPP; c(4,5)= 11025._RPP/16384._RPP; c(3,5)= -735._RPP/ 4096._RPP ! stencil 5 + c(5,6)= 3465._RPP/ 4096._RPP; c(4,6)= -5775._RPP/16384._RPP; c(3,6)= 693._RPP/ 4096._RPP ! stencil 6 + c(5,7)= -3003._RPP/ 4096._RPP; c(4,7)= 9009._RPP/16384._RPP; c(3,7)= -1287._RPP/ 4096._RPP ! stencil 7 + c(5,8)= 9009._RPP/ 4096._RPP; c(4,8)= -32175._RPP/16384._RPP; c(3,8)= 5005._RPP/ 4096._RPP ! stencil 8 + ! cell 2 ; cell 1 ; cell 0 + c(2,0)= 153153._RPP/ 8192._RPP; c(1,0)= -36465._RPP/ 4096._RPP; c(0,0)= 109395._RPP/32768._RPP ! stencil 0 + c(2,1)= -15015._RPP/ 8192._RPP; c(1,1)= 6435._RPP/ 4096._RPP; c(0,1)= 6435._RPP/32768._RPP ! stencil 1 + c(2,2)= 9009._RPP/ 8192._RPP; c(1,2)= 1287._RPP/ 4096._RPP; c(0,2)= -429._RPP/32768._RPP ! stencil 2 + c(2,3)= 3465._RPP/ 8192._RPP; c(1,3)= -165._RPP/ 4096._RPP; c(0,3)= 99._RPP/32768._RPP ! stencil 3 + c(2,4)= -735._RPP/ 8192._RPP; c(1,4)= 63._RPP/ 4096._RPP; c(0,4)= -45._RPP/32768._RPP ! stencil 4 + c(2,5)= 441._RPP/ 8192._RPP; c(1,5)= -45._RPP/ 4096._RPP; c(0,5)= 35._RPP/32768._RPP ! stencil 5 + c(2,6)= -495._RPP/ 8192._RPP; c(1,6)= 55._RPP/ 4096._RPP; c(0,6)= -45._RPP/32768._RPP ! stencil 6 + c(2,7)= 1001._RPP/ 8192._RPP; c(1,7)= -117._RPP/ 4096._RPP; c(0,7)= 99._RPP/32768._RPP ! stencil 7 + c(2,8)= -4095._RPP/ 8192._RPP; c(1,8)= 495._RPP/ 4096._RPP; c(0,8)= -429._RPP/32768._RPP ! stencil 8 endselect else ! internal point + allocate(f(0:S-1, 0:S-1)) do k=0,S-1 !stencils loop c_sum = 0._RPP do j=0,S-2 !values loop @@ -329,10 +331,15 @@ subroutine create(self, constructor) if (i==j) cycle prod = prod * ((x_target - stencil(-S+k+i+1)) / (stencil(-S+k+j+1) - stencil(-S+k+i+1))) enddo - c(j,k) = prod + f(j,k) = prod c_sum = c_sum + prod enddo - c(S-1,k) = 1._RPP - c_sum + f(S-1,k) = 1._RPP - c_sum + enddo + do k=0,S-1 + do j=0,S-1 + c(j,k) = f(S-1-j,k) + enddo enddo endif endassociate From 10efeecacd5cc68621b309d6e2c33b80c0bfa755 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 14:49:22 +0200 Subject: [PATCH 81/90] fix optimal weights --- .../concrete_objects/wenoof_kappa_int_js.F90 | 38 ++++++++++++------- 1 file changed, 24 insertions(+), 14 deletions(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index fd7b790..ed9e3dd 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -75,15 +75,15 @@ pure subroutine compute_kappa_rec(self) pure subroutine compute_kappa_int(self, stencil, x_target) !< Compute kappa. - class(kappa_int_js), intent(inout) :: self !< Kappa. - real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for interpolation, [1-S:S-1]. - real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. - real(RPP) :: coeff(0:2*self%S-2) !< Interpolation coefficients on the whole stencil. - real(RPP) :: ffeoc(0:2*self%S-2) !< Temporary variable. - real(RPP) :: prod !< Temporary variable. - real(RPP) :: coeff_t !< Temporary variable. - real(RPP) :: val_sum !< Temporary variable. - integer(I_P) :: i, j, k !< Counters. + class(kappa_int_js), intent(inout) :: self !< Kappa. + real(RPP), intent(in) :: stencil(1-self%S:) !< Stencil used for interpolation, [1-S:S-1]. + real(RPP), intent(in) :: x_target !< Coordinate of the interpolation point. + real(RPP) :: coeff(0:2*self%S-2) !< Interpolation coefficients on the whole stencil. + real(RPP) :: coef(0:self%S-1,0:self%S-1) !< Temporary variable. + real(RPP) :: prod !< Temporary variable. + real(RPP) :: coeff_t !< Temporary variable. + real(RPP) :: val_sum !< Temporary variable. + integer(I_P) :: i, j, k !< Counters. associate(S => self%S, val => self%values_rank_1, interp => self%interpolations) if(x_target==-0.5_RPP) then @@ -198,28 +198,38 @@ pure subroutine compute_kappa_int(self, stencil, x_target) val(7) = 85._RPP/8192._RPP ! stencil 7 val(8) = 17._RPP/65536._RPP ! stencil 8 endselect + elseif((x_target>-self%eps).and.(x_target Date: Thu, 6 Apr 2017 14:53:54 +0200 Subject: [PATCH 82/90] update submodules --- src/third_party/FLOw | 1 + src/third_party/FORESEER | 1 + src/third_party/VecFor | 1 + 3 files changed, 3 insertions(+) create mode 160000 src/third_party/FLOw create mode 160000 src/third_party/FORESEER create mode 160000 src/third_party/VecFor diff --git a/src/third_party/FLOw b/src/third_party/FLOw new file mode 160000 index 0000000..8e68fb3 --- /dev/null +++ b/src/third_party/FLOw @@ -0,0 +1 @@ +Subproject commit 8e68fb33282cab9a92c7ca420f5921eda7a0ad8b diff --git a/src/third_party/FORESEER b/src/third_party/FORESEER new file mode 160000 index 0000000..26cea43 --- /dev/null +++ b/src/third_party/FORESEER @@ -0,0 +1 @@ +Subproject commit 26cea43b4493bac72a0c50dd90dc78aa8c4f7347 diff --git a/src/third_party/VecFor b/src/third_party/VecFor new file mode 160000 index 0000000..2b0d471 --- /dev/null +++ b/src/third_party/VecFor @@ -0,0 +1 @@ +Subproject commit 2b0d471e138f46b97103ad47ee286b7fa98f27b3 From fe2e0e6a8d5dbb19efe5ac565860fdef2e010aac Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 14:56:40 +0200 Subject: [PATCH 83/90] update submodules --- src/third_party/FOODIE | 2 +- src/third_party/pyplot-fortran | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/third_party/FOODIE b/src/third_party/FOODIE index 10113d3..7c9ca89 160000 --- a/src/third_party/FOODIE +++ b/src/third_party/FOODIE @@ -1 +1 @@ -Subproject commit 10113d3a009609f3529f11dab96d364d6e3c9e7b +Subproject commit 7c9ca89eaee606a6669b265bcdb458fa7d16ffdd diff --git a/src/third_party/pyplot-fortran b/src/third_party/pyplot-fortran index 88c1ce0..24e9673 160000 --- a/src/third_party/pyplot-fortran +++ b/src/third_party/pyplot-fortran @@ -1 +1 @@ -Subproject commit 88c1ce059f805bdd55dca51220daa881f38ba7bf +Subproject commit 24e9673d1da0f8bb13255ba367a58e70d54e8c27 From 98862a9de1d800a32510d1eb714e643d7013b7cf Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 15:20:38 +0200 Subject: [PATCH 84/90] add submodules --- .gitmodules | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index 4e06805..8b5619b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -10,9 +10,23 @@ path = src/third_party/FLAP url = https://github.com/szaghi/FLAP branch = master -[submodule "src/third_party/FACE"] - path = src/third_party/FACE - url = https://github.com/szaghi/FACE.git [submodule "src/third_party/FOODIE"] - path = src/third_party/FOODIE - url = https://github.com/Fortran-FOSS-Programmers/FOODIE.git + path = src/third_party/FOODIE + url = https://github.com/Fortran-FOSS-Programmers/FOODIE + branch = master +[submodule "src/third_party/FACE"] + path = src/third_party/FACE + url = https://github.com/szaghi/FACE + branch = master +[submodule "src/third_party/FORESEER"] + path = src/third_party/FORESEER + url = https://github.com/szaghi/FORESEER + branch = master +[submodule "src/third_party/FLOw"] + path = src/third_party/FLOw + url = https://github.com/szaghi/FLOw + branch = master +[submodule "src/third_party/VecFor"] + path = src/third_party/VecFor + url = https://github.com/szaghi/VecFor + branch = master From 1e97b3c98ecc0c06248c6093fa76851ab86105da Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 15:23:49 +0200 Subject: [PATCH 85/90] exclude third party dirs --- fobos | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/fobos b/fobos index bfe15ea..e2e9a04 100644 --- a/fobos +++ b/fobos @@ -10,16 +10,17 @@ $CSHARED_INT = -cpp -c -fpic -assume realloc_lhs $LSHARED = -shared $CSTATIC_GNU = -cpp -c -frealloc-lhs $CSTATIC_INT = -cpp -c -assume realloc_lhs -$DEBUG_GNU = -Og -g3 -Warray-bounds -Wcharacter-truncation -Wline-truncation -Wimplicit-interface -Wimplicit-procedure -Wunderflow -fcheck=all -fmodule-private -ffree-line-length-132 -fimplicit-none -fbacktrace -fdump-core -finit-real=nan -std=f2008 -fall-intrinsics +$DEBUG_GNU = -Og -g3 -ffpe-trap=invalid -Warray-bounds -Wcharacter-truncation -Wline-truncation -Wimplicit-interface -Wimplicit-procedure -Wunderflow -fcheck=all -fmodule-private -ffree-line-length-132 -fimplicit-none -fbacktrace -fdump-core -finit-real=nan -std=f2008 -fall-intrinsics $DEBUG_INT = -O0 -debug all -check all -warn all -extend-source 132 -traceback -gen-interfaces#-fpe-all=0 -fp-stack-check -fstack-protector-all -ftrapuv -no-ftz -std08 $OPTIMIZE = -O2 $EXDIRS = FACE/src/tests FACE/src/third_party/ FLAP/src/tests/ FLAP/src/third_party/ - PENF/src/tests/ PENF/src/third_party/ + FLOw/src/tests/ FLOw/src/third_party/ FOODIE/src/tests FOODIE/src/third_party/ - FLOw/src FLOw/src/tests FLOw/src/third_party/ + FORESEER/src/tests FORESEER/src/third_party/ + PENF/src/tests/ PENF/src/third_party/ pyplot-fortran/src/tests/ - FORESEER/src/tests/ + VecFor/src/tests/ VecFor/src/third_party/ # main modes # GNU @@ -126,7 +127,7 @@ jobs = 2 compiler = gnu cflags = $CSHARED_GNU $DEBUG_GNU lflags = $LSHARED $DEBUG_GNU -preproc = -DDEBUG -Dr16p +preproc = -DDEBUG exclude_dirs = $EXDIRS mod_dir = ./mod/ obj_dir = ./obj/ @@ -140,7 +141,7 @@ jobs = 2 compiler = gnu cflags = $CSTATIC_GNU $DEBUG_GNU lflags = $DEBUG_GNU -preproc = -DDEBUG -Dr16p +preproc = -DDEBUG exclude_dirs = $EXDIRS mod_dir = ./mod/ obj_dir = ./obj/ @@ -180,7 +181,7 @@ jobs = 2 compiler = intel cflags = $CSHARED_INT $DEBUG_INT lflags = $LSHARED $DEBUG_INT -preproc = -DDEBUG -Dr16p +preproc = -DDEBUG exclude_dirs = $EXDIRS mod_dir = ./mod/ obj_dir = ./obj/ @@ -194,7 +195,7 @@ jobs = 2 compiler = intel cflags = $CSTATIC_INT $DEBUG_INT lflags = $DEBUG_INT -preproc = -DDEBUG -Dr16p +preproc = -DDEBUG exclude_dirs = $EXDIRS mod_dir = ./mod/ obj_dir = ./obj/ @@ -235,7 +236,7 @@ help = Perform coverage analysis rule_1 = FoBiS.py clean -mode tests-gnu rule_2 = FoBiS.py build -mode tests-gnu -coverage rule_3 = ./scripts/run_tests.sh -rule_4 = rm -f exe/obj/penf* exe/obj/vecfor* +rule_4 = rm -f exe/obj/penf* exe/obj/face* exe/obj/flap* exe/obj/flow* exe/obj/foodie* exe/obj/vecfor* rule_5 = gcov -o exe/obj/ src/lib/wenoof* rule_6 = rm -f *.gcov @@ -244,7 +245,7 @@ help = Perform coverage analysis and saving reports in markdown rule_1 = FoBiS.py clean -mode tests-gnu rule_2 = FoBiS.py build -mode tests-gnu -coverage rule_3 = ./scripts/run_tests.sh -rule_4 = rm -f exe/obj/penf* exe/obj/vecfor* +rule_4 = rm -f exe/obj/penf* exe/obj/face* exe/obj/flap* exe/obj/flow* exe/obj/foodie* exe/obj/vecfor* rule_5 = gcov -o exe/obj/ src/lib/wenoof* rule_6 = FoBiS.py rule -gcov_analyzer wiki/ Coverage-Analysis rule_7 = rm -f *.gcov From 103277c6901480c41593294dedb1241c9eb01062 Mon Sep 17 00:00:00 2001 From: Giacomo Rossi Date: Thu, 6 Apr 2017 23:20:48 +0200 Subject: [PATCH 86/90] remove wrong elseif --- src/lib/concrete_objects/wenoof_kappa_int_js.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 index ed9e3dd..8226436 100644 --- a/src/lib/concrete_objects/wenoof_kappa_int_js.F90 +++ b/src/lib/concrete_objects/wenoof_kappa_int_js.F90 @@ -198,7 +198,6 @@ pure subroutine compute_kappa_int(self, stencil, x_target) val(7) = 85._RPP/8192._RPP ! stencil 7 val(8) = 17._RPP/65536._RPP ! stencil 8 endselect - elseif((x_target>-self%eps).and.(x_target Date: Thu, 6 Apr 2017 23:21:20 +0200 Subject: [PATCH 87/90] update submodules --- src/third_party/FOODIE | 2 +- src/third_party/pyplot-fortran | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/third_party/FOODIE b/src/third_party/FOODIE index 7c9ca89..10113d3 160000 --- a/src/third_party/FOODIE +++ b/src/third_party/FOODIE @@ -1 +1 @@ -Subproject commit 7c9ca89eaee606a6669b265bcdb458fa7d16ffdd +Subproject commit 10113d3a009609f3529f11dab96d364d6e3c9e7b diff --git a/src/third_party/pyplot-fortran b/src/third_party/pyplot-fortran index 24e9673..88c1ce0 160000 --- a/src/third_party/pyplot-fortran +++ b/src/third_party/pyplot-fortran @@ -1 +1 @@ -Subproject commit 24e9673d1da0f8bb13255ba367a58e70d54e8c27 +Subproject commit 88c1ce059f805bdd55dca51220daa881f38ba7bf From 21d9741c0215fcd629b78e5e17999adfb44ebc83 Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Fri, 7 Apr 2017 13:48:54 +0200 Subject: [PATCH 88/90] update submodule --- src/third_party/FACE | 2 +- src/third_party/FLAP | 2 +- src/third_party/FLOw | 2 +- src/third_party/FOODIE | 2 +- src/third_party/FORESEER | 2 +- src/third_party/VecFor | 2 +- src/third_party/pyplot-fortran | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/third_party/FACE b/src/third_party/FACE index bc82908..04e6b28 160000 --- a/src/third_party/FACE +++ b/src/third_party/FACE @@ -1 +1 @@ -Subproject commit bc8290874430b454ec57e255185ba1ab7419766f +Subproject commit 04e6b28cd94bf5b8c1816a9ac52f2745f5efb213 diff --git a/src/third_party/FLAP b/src/third_party/FLAP index 0069a3b..3243f11 160000 --- a/src/third_party/FLAP +++ b/src/third_party/FLAP @@ -1 +1 @@ -Subproject commit 0069a3b8026db5c1331e0b2adfce92250eb1846d +Subproject commit 3243f11b9ca4cdb932a6d514eb42415e9aad5eaa diff --git a/src/third_party/FLOw b/src/third_party/FLOw index 8e68fb3..b55ab56 160000 --- a/src/third_party/FLOw +++ b/src/third_party/FLOw @@ -1 +1 @@ -Subproject commit 8e68fb33282cab9a92c7ca420f5921eda7a0ad8b +Subproject commit b55ab562ef109a43d336db9f7dd3f6c13e877d3a diff --git a/src/third_party/FOODIE b/src/third_party/FOODIE index 10113d3..ea995f7 160000 --- a/src/third_party/FOODIE +++ b/src/third_party/FOODIE @@ -1 +1 @@ -Subproject commit 10113d3a009609f3529f11dab96d364d6e3c9e7b +Subproject commit ea995f7303afe936cf12cd7d40cdf07959ecd0de diff --git a/src/third_party/FORESEER b/src/third_party/FORESEER index 26cea43..f95309b 160000 --- a/src/third_party/FORESEER +++ b/src/third_party/FORESEER @@ -1 +1 @@ -Subproject commit 26cea43b4493bac72a0c50dd90dc78aa8c4f7347 +Subproject commit f95309b21d84aa161a8636ef66365dffa898001b diff --git a/src/third_party/VecFor b/src/third_party/VecFor index 2b0d471..f1ef102 160000 --- a/src/third_party/VecFor +++ b/src/third_party/VecFor @@ -1 +1 @@ -Subproject commit 2b0d471e138f46b97103ad47ee286b7fa98f27b3 +Subproject commit f1ef1024d7f6546d118983cecadd9d3ae2b4d53d diff --git a/src/third_party/pyplot-fortran b/src/third_party/pyplot-fortran index 88c1ce0..24e9673 160000 --- a/src/third_party/pyplot-fortran +++ b/src/third_party/pyplot-fortran @@ -1 +1 @@ -Subproject commit 88c1ce059f805bdd55dca51220daa881f38ba7bf +Subproject commit 24e9673d1da0f8bb13255ba367a58e70d54e8c27 From 8fdac0304c90eeb0ed1eefac4cec11195063b7be Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Fri, 7 Apr 2017 15:11:03 +0200 Subject: [PATCH 89/90] restore automatic code codeverage --- fobos | 4 +- src/tests/polynoms_test.f90 | 22 ++++-- src/tests/sin_test.f90 | 22 ++++-- src/tests/wenoof_test_ui.f90 | 143 +++++++++++------------------------ 4 files changed, 81 insertions(+), 110 deletions(-) diff --git a/fobos b/fobos index e2e9a04..d84e270 100644 --- a/fobos +++ b/fobos @@ -236,7 +236,7 @@ help = Perform coverage analysis rule_1 = FoBiS.py clean -mode tests-gnu rule_2 = FoBiS.py build -mode tests-gnu -coverage rule_3 = ./scripts/run_tests.sh -rule_4 = rm -f exe/obj/penf* exe/obj/face* exe/obj/flap* exe/obj/flow* exe/obj/foodie* exe/obj/vecfor* +rule_4 = rm -f exe/obj/face* exe/obj/flap* exe/obj/flow* exe/obj/foodie* exe/obj/foreseer* exe/obj/penf* exe/obj/pyplot* exe/obj/vecfor* rule_5 = gcov -o exe/obj/ src/lib/wenoof* rule_6 = rm -f *.gcov @@ -245,7 +245,7 @@ help = Perform coverage analysis and saving reports in markdown rule_1 = FoBiS.py clean -mode tests-gnu rule_2 = FoBiS.py build -mode tests-gnu -coverage rule_3 = ./scripts/run_tests.sh -rule_4 = rm -f exe/obj/penf* exe/obj/face* exe/obj/flap* exe/obj/flow* exe/obj/foodie* exe/obj/vecfor* +rule_4 = rm -f exe/obj/face* exe/obj/flap* exe/obj/flow* exe/obj/foodie* exe/obj/foreseer* exe/obj/penf* exe/obj/pyplot* exe/obj/vecfor* rule_5 = gcov -o exe/obj/ src/lib/wenoof* rule_6 = FoBiS.py rule -gcov_analyzer wiki/ Coverage-Analysis rule_7 = rm -f *.gcov diff --git a/src/tests/polynoms_test.f90 b/src/tests/polynoms_test.f90 index ad476d6..7335f44 100644 --- a/src/tests/polynoms_test.f90 +++ b/src/tests/polynoms_test.f90 @@ -68,13 +68,25 @@ subroutine execute(self) class(test), intent(inout) :: self !< Test. call self%ui%get - if (trim(adjustl(self%ui%interpolator_type))/='all') then - call self%perform + if (self%ui%interpolate.and.self%ui%reconstruct) then + call subexecute + self%ui%interpolate = .false. + call subexecute else - do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) - call self%perform - enddo + call subexecute endif + contains + subroutine subexecute + !< Subexecute test(s). + + if (trim(adjustl(self%ui%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine subexecute endsubroutine execute ! private methods diff --git a/src/tests/sin_test.f90 b/src/tests/sin_test.f90 index b2f68b7..e7f3949 100644 --- a/src/tests/sin_test.f90 +++ b/src/tests/sin_test.f90 @@ -68,13 +68,25 @@ subroutine execute(self) class(test), intent(inout) :: self !< Test. call self%ui%get - if (trim(adjustl(self%ui%interpolator_type))/='all') then - call self%perform + if (self%ui%interpolate.and.self%ui%reconstruct) then + call subexecute + self%ui%interpolate = .false. + call subexecute else - do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) - call self%perform - enddo + call subexecute endif + contains + subroutine subexecute + !< Subexecute test(s). + + if (trim(adjustl(self%ui%interpolator_type))/='all') then + call self%perform + else + do while(self%ui%loop_interpolator(interpolator=self%ui%interpolator_type)) + call self%perform + enddo + endif + endsubroutine subexecute endsubroutine execute ! private methods diff --git a/src/tests/wenoof_test_ui.f90 b/src/tests/wenoof_test_ui.f90 index ff24076..ac6fb70 100644 --- a/src/tests/wenoof_test_ui.f90 +++ b/src/tests/wenoof_test_ui.f90 @@ -31,7 +31,8 @@ module wenoof_test_ui integer(I_P), allocatable :: S(:) !< Stencils used. real(RPP) :: eps !< Small epsilon to avoid zero-division. real(RPP) :: x_target !< Interpolation target coordinate. - logical :: interpolate !< Flag for activating interpolation. + logical :: interpolate=.false. !< Flag for activating interpolation. + logical :: reconstruct=.false. !< Flag for activating reconstruction. logical :: errors_analysis=.false. !< Flag for activating errors analysis. logical :: plots=.false. !< Flag for activating plots saving. logical :: results=.false. !< Flag for activating results saving. @@ -55,67 +56,32 @@ subroutine set_cli() !< Set Command Line Interface. associate(cli => self%cli) - call cli%init(progname = 'WenOOF Test', & - authors = 'Fortran-FOSS-Programmers', & - license = 'GNU GPLv3', & - description = 'Test WenOOF library on function reconstruction', & - examples = ["$EXECUTABLE interpolate -i JS --results", & - "$EXECUTABLE interpolate -i JS-Z -r ", & - "$EXECUTABLE reconstruct -i JS-M ", & - "$EXECUTABLE reconstruct -i all -p -r "]) + call cli%init(progname = 'WenOOF Test', & + authors = 'Fortran-FOSS-Programmers', & + license = 'GNU GPLv3', & + description = 'Test WenOOF library on function reconstruction', & + examples = ["$EXECUTABLE --interpolate -i JS --results", & + "$EXECUTABLE --interpolate -i JS-Z -r ", & + "$EXECUTABLE --reconstruct -i JS-M ", & + "$EXECUTABLE --reconstruct -i all -p -r "]) - call cli%add_group(group='interpolate', description='perform WENO interpolation') - call cli%add (group='interpolate', switch='--x_target', switch_ab='-x', & - help='WENO interpolation target point coordinate', & - required=.true., def='0', act='store') - call cli%add (group='interpolate', switch='--interpolator', switch_ab='-i', & - help='WENO interpolator type', required=.false., & - def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') - call cli%add (group='interpolate', switch='--points_number', switch_ab='-pn', nargs='+', & - help='Number of points used to discretize the domain', & - required=.false., act='store', def='50 100') - call cli%add (group='interpolate', switch='--stencils', switch_ab='-s', nargs='+', & - help='Stencils dimensions (and number)', required=.false., act='store', & - def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') - call cli%add (group='interpolate', switch='--eps', help='Small epsilon to avoid zero-division', & - required=.false., act='store', def='1.e-6') - call cli%add (group='interpolate', switch='--output_dir', help='Output directory', required=.false., & - act='store', def='./') - call cli%add (group='interpolate', switch='--results', switch_ab='-r', help='Save results', required=.false., & - act='store_true', def='.false.') - call cli%add (group='interpolate', switch='--plots', switch_ab='-p', help='Save plots', required=.false., & - act='store_true', def='.false.') - call cli%add (group='interpolate', switch='--output', help='Output files basename', required=.false., & - act='store', def='output') - call cli%add (group='interpolate', switch='--errors_analysis', help='Peform errors analysis', required=.false., & - act='store_true', def='.false.') - call cli%add (group='interpolate', switch='--verbose', help='Verbose output', required=.false., & - act='store_true', def='.false.') - - call cli%add_group(group='reconstruct', description='perform WENO reconstruction') - call cli%add (group='reconstruct', switch='--interpolator', switch_ab='-i', & - help='WENO interpolator type', required=.false., & - def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') - call cli%add (group='reconstruct', switch='--points_number', switch_ab='-pn', nargs='+', & - help='Number of points used to discretize the domain', & - required=.false., act='store', def='50 100') - call cli%add (group='reconstruct', switch='--stencils', switch_ab='-s', nargs='+', & - help='Stencils dimensions (and number)', required=.false., act='store', & - def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') - call cli%add (group='reconstruct', switch='--eps', help='Small epsilon to avoid zero-division', & - required=.false., act='store', def='1.e-6') - call cli%add (group='reconstruct', switch='--output_dir', help='Output directory', required=.false., & - act='store', def='./') - call cli%add (group='reconstruct', switch='--results', switch_ab='-r', help='Save results', required=.false., & - act='store_true', def='.false.') - call cli%add (group='reconstruct', switch='--plots', switch_ab='-p', help='Save plots', required=.false., & - act='store_true', def='.false.') - call cli%add (group='reconstruct', switch='--output', help='Output files basename', required=.false., & - act='store', def='output') - call cli%add (group='reconstruct', switch='--errors_analysis', help='Peform errors analysis', required=.false., & - act='store_true', def='.false.') - call cli%add (group='reconstruct', switch='--verbose', help='Verbose output', required=.false., & - act='store_true', def='.false.') + call cli%add(switch='--interpolate', help='Perform interpolation', required=.false., act='store_true', def='.false.') + call cli%add(switch='--reconstruct', help='Perform interpolation', required=.false., act='store_true', def='.false.') + call cli%add(switch='--x_target', switch_ab='-x', help='WENO interpolation target point coordinate', & + required=.false., def='0.0', act='store') + call cli%add(switch='--interpolator', switch_ab='-i', help='WENO interpolator type', required=.false., & + def='JS', act='store', choices='all,JS,M-JS,M-Z,Z') + call cli%add(switch='--points_number', switch_ab='-pn', nargs='+', help='Number of points used to discretize the domain', & + required=.false., act='store', def='50 100') + call cli%add(switch='--stencils', switch_ab='-s', nargs='+', help='Stencils dimensions (and number)', required=.false., & + act='store', def='2 3 4 5 6 7 8 9', choices='2, 3, 4, 5, 6, 7, 8, 9') + call cli%add(switch='--eps', help='Small epsilon to avoid zero-division', required=.false., act='store', def='1.e-6') + call cli%add(switch='--output_dir', help='Output directory', required=.false., act='store', def='./') + call cli%add(switch='--results', switch_ab='-r', help='Save results', required=.false., act='store_true', def='.false.') + call cli%add(switch='--plots', switch_ab='-p', help='Save plots', required=.false., act='store_true', def='.false.') + call cli%add(switch='--output', help='Output files basename', required=.false., act='store', def='output') + call cli%add(switch='--errors_analysis', help='Peform errors analysis', required=.false., act='store_true', def='.false.') + call cli%add(switch='--verbose', help='Verbose output', required=.false., act='store_true', def='.false.') endassociate endsubroutine set_cli @@ -123,43 +89,24 @@ subroutine parse_cli() !< Parse Command Line Interface and check its validity. call self%cli%parse(error=self%error) ; if (self%error/=0) stop - if (self%cli%run_command(group='interpolate')) then - self%interpolate=.true. - call self%cli%get(group='interpolate', switch='-x', val=self%x_target, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(group='interpolate', switch='-pn', val=self%points_number, error=self%error) - if (self%error/=0) stop - call self%cli%get_varying(group='interpolate', switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='--output_dir', val=self%output_dir, error=self%error) - if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='--errors_analysis', val=self%errors_analysis, error=self%error) - if (self%error/=0) stop - call self%cli%get(group='interpolate', switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop - elseif (self%cli%run_command(group='reconstruct')) then - self%interpolate=.false. - call self%cli%get(group='reconstruct', switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop - call self%cli%get_varying(group='reconstruct', switch='-pn', val=self%points_number, error=self%error) - if (self%error/=0) stop - call self%cli%get_varying(group='reconstruct', switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='--output_dir', val=self%output_dir, error=self%error) - if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='--errors_analysis', val=self%errors_analysis, error=self%error) - if (self%error/=0) stop - call self%cli%get(group='reconstruct', switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop - else -#ifndef DEBUG - ! error stop in pure procedure is a F2015 feature not yet supported in debug mode - call self%cli%print_usage - error stop 'error: action not present; choose the correct action between "interpolate" and "reconstruct"' -#endif + call self%cli%get(switch='--interpolate', val=self%interpolate, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--reconstruct', val=self%reconstruct, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-x', val=self%x_target, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-i', val=self%interpolator_type, error=self%error) ; if (self%error/=0) stop + call self%cli%get_varying(switch='-pn', val=self%points_number, error=self%error) ; if (self%error/=0) stop + call self%cli%get_varying(switch='-s', val=self%S, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--eps', val=self%eps, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--output_dir', val=self%output_dir, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-r', val=self%results, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='-p', val=self%plots, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--output', val=self%output_bname, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--errors_analysis', val=self%errors_analysis, error=self%error) ; if (self%error/=0) stop + call self%cli%get(switch='--verbose', val=self%verbose, error=self%error) ; if (self%error/=0) stop + + if ((.not.self%interpolate).and.(.not.self%reconstruct)) then + ! activate both for coverage tests + self%interpolate = .true. + self%reconstruct = .true. endif self%pn_number = size(self%points_number, dim=1) From 497dd853ebfd08da47e81fc865c0ca334ed7217a Mon Sep 17 00:00:00 2001 From: Stefano Zaghi Date: Fri, 7 Apr 2017 16:42:35 +0200 Subject: [PATCH 90/90] update doc main page --- doc/main_page.md | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/doc/main_page.md b/doc/main_page.md index 1dd3d37..c7373f9 100644 --- a/doc/main_page.md +++ b/doc/main_page.md @@ -1,7 +1,17 @@ +--- project: WenOOF -src_dir: ../src +src_dir: ../src/lib +src_dir: ../src/tests +src_dir: ../src/third_party/PENF/src/lib +src_dir: ../src/third_party/FACE/src/lib +src_dir: ../src/third_party/FLAP/src/lib +src_dir: ../src/third_party/FLOw/src/lib +src_dir: ../src/third_party/FOODIE/src/lib +src_dir: ../src/third_party/FORESEER/src/lib +src_dir: ../src/third_party/VecFor/src/lib output_dir: html/publish/ project_github: https://github.com/Fortran-FOSS-Programmers/WenOOF +project_download: https://github.com/Fortran-FOSS-Programmers/WenOOF/releases/latest summary: WENO interpolation Object Oriented Fortran library author: Fortran-FOSS-Programmers github: http://fortran-foss-programmers.github.io/ @@ -16,7 +26,11 @@ display: public private source: true warn: true -search: false graph: true +sort: alpha +print_creation_date: true +creation_date: %Y-%m-%d %H:%M %z +extra_mods: iso_fortran_env:https://gcc.gnu.org/onlinedocs/gfortran/ISO_005fFORTRAN_005fENV.html {!../README.md!} +---