diff options
| author | diener <diener@f69c4107-0314-4c4f-9ad4-17e986b73f4a> | 2007-10-16 14:45:23 +0000 |
|---|---|---|
| committer | diener <diener@f69c4107-0314-4c4f-9ad4-17e986b73f4a> | 2007-10-16 14:45:23 +0000 |
| commit | f4cc81a52f102c61b07178b88d4a560b307d928f (patch) | |
| tree | ae8d9b3dcbf84f6c2180622f0e7da3661d4fdcd4 | |
| parent | bb568eb19331f243f79abc3a5b3e9331959c8773 (diff) | |
Moved definitions of coefficients to a single module in order to only have
them in one place. Added routines to return coefficients in all the
missing cases. Also added routines to return 2 derivatives (only 2-1 and
4-2 so far). The routines calculating derivatives for whole grid functions
have not been tested yet, so if you are using them, you will probably want
to hold off on updating until I give the clear signal.
git-svn-id: https://svn.cct.lsu.edu/repos/numrel/LSUThorns/SummationByParts/trunk@85 f69c4107-0314-4c4f-9ad4-17e986b73f4a
34 files changed, 3547 insertions, 1694 deletions
diff --git a/interface.ccl b/interface.ccl index 4bb3bc0..a9f203d 100644 --- a/interface.ccl +++ b/interface.ccl @@ -25,6 +25,13 @@ SUBROUTINE Diff_up_gv ( CCTK_POINTER_TO_CONST IN cctkGH, \ CCTK_INT IN table_handle ) PROVIDES FUNCTION Diff_up_gv WITH DiffUpGv LANGUAGE C +SUBROUTINE Diff2_gv ( CCTK_POINTER_TO_CONST IN cctkGH, \ + CCTK_INT IN dir, \ + CCTK_REAL IN ARRAY var, \ + CCTK_REAL OUT ARRAY dvar, \ + CCTK_INT IN table_handle ) +PROVIDES FUNCTION Diff2_gv WITH DiffGv2 LANGUAGE C + SUBROUTINE Diff_coeff ( CCTK_POINTER_TO_CONST IN cctkGH, \ CCTK_INT IN dir, \ CCTK_INT IN nsize, \ @@ -34,6 +41,25 @@ SUBROUTINE Diff_coeff ( CCTK_POINTER_TO_CONST IN cctkGH, \ CCTK_INT IN table_handle ) PROVIDES FUNCTION Diff_coeff WITH DiffCoeff LANGUAGE C +SUBROUTINE Diff_up_coeff ( CCTK_POINTER_TO_CONST IN cctkGH, \ + CCTK_INT IN dir, \ + CCTK_INT IN nsize, \ + CCTK_INT OUT ARRAY imin, \ + CCTK_INT OUT ARRAY imax, \ + CCTK_REAL OUT ARRAY q, \ + CCTK_INT IN up, \ + CCTK_INT IN table_handle ) +PROVIDES FUNCTION Diff_up_coeff WITH DiffUpCoeff LANGUAGE C + +SUBROUTINE Diff2_coeff ( CCTK_POINTER_TO_CONST IN cctkGH, \ + CCTK_INT IN dir, \ + CCTK_INT IN nsize, \ + CCTK_INT OUT ARRAY imin, \ + CCTK_INT OUT ARRAY imax, \ + CCTK_REAL OUT ARRAY q, \ + CCTK_INT IN table_handle ) +PROVIDES FUNCTION Diff2_coeff WITH DiffCoeff2 LANGUAGE C + #Routine to return the coefficients for the diagonal norms. SUBROUTINE GetScalProdDiag ( CCTK_POINTER_TO_CONST IN cctkGH, \ CCTK_INT IN dir, \ diff --git a/src/All_Coeffs_mod.F90 b/src/All_Coeffs_mod.F90 new file mode 100644 index 0000000..ef965d8 --- /dev/null +++ b/src/All_Coeffs_mod.F90 @@ -0,0 +1,1323 @@ +! $Header$ + +#include "cctk.h" + +module All_Coeffs_mod + + implicit none + + CCTK_REAL, parameter :: zero = 0.0 + integer, parameter :: wp = kind(zero) + + contains + + subroutine coeffs_1_2_1 ( a, q ) + + CCTK_REAL, dimension(1), intent(OUT) :: a + CCTK_REAL, dimension(3,2), intent(OUT) :: q + + a(1) = 1.0_wp/2.0_wp + + q(1,1) = -1.0_wp + q(2,1) = 1.0_wp + q(3,1) = zero + + q(1,2) = -1.0_wp/2.0_wp + q(2,2) = zero + q(3,2) = 1.0_wp/2.0_wp + + end subroutine coeffs_1_2_1 + + subroutine coeffs_up_2_1 ( a1, q1, a2, q2 ) + + CCTK_REAL, dimension(-1:1), intent(OUT) :: a1, a2 + CCTK_REAL, dimension(3,2), intent(OUT) :: q1, q2 + + a1(-1) = -1.0_wp + a1(0) = 1.0_wp + a1(1) = zero + + q1(1,1) = zero + q1(2,1) = zero + q1(3,1) = zero + + q1(1,2) = -1.0_wp + q1(2,2) = 1.0_wp + q1(3,2) = zero + + a2(-1) = zero + a2(0) = -1.0_wp + a2(1) = 1.0_wp + + q2(1,1) = -2.0_wp + q2(2,1) = 2.0_wp + q2(3,1) = zero + + q2(1,2) = zero + q2(2,2) = -1.0_wp + q2(3,2) = 1.0_wp + + end subroutine coeffs_up_2_1 + + subroutine coeffs_2_2_1 ( a, q ) + + CCTK_REAL, dimension(2), intent(OUT) :: a + CCTK_REAL, dimension(3,2), intent(OUT) :: q + + a(1) = -2.0_wp + a(2) = 1.0_wp + + q(1,1) = 1.0_wp + q(2,1) = -2.0_wp + q(3,1) = 1.0_wp + q(1,2) = 1.0_wp + q(2,2) = -2.0_wp + q(3,2) = 1.0_wp + + end subroutine coeffs_2_2_1 + + subroutine coeffs_1_4_2 ( a, q ) + + CCTK_REAL, dimension(2), intent(OUT) :: a + CCTK_REAL, dimension(6,4), intent(OUT) :: q + + a(1) = 2.0_wp/3.0_wp + a(2) = -1.0_wp/12.0_wp + + q(1,1) = -24.0_wp/17.0_wp + q(2,1) = 59.0_wp/34.0_wp + q(3,1) = -4.0_wp/17.0_wp + q(4,1) = -3.0_wp/34.0_wp + q(5,1) = zero + q(6,1) = zero + + q(1,2) = -1.0_wp/2.0_wp + q(2,2) = zero + q(3,2) = 1.0_wp/2.0_wp + q(4,2) = zero + q(5,2) = zero + q(6,2) = zero + + q(1,3) = 4.0_wp/43.0_wp + q(2,3) = -59.0_wp/86.0_wp + q(3,3) = zero + q(4,3) = 59.0_wp/86.0_wp + q(5,3) = -4.0_wp/43.0_wp + q(6,3) = zero + + q(1,4) = 3.0_wp/98.0_wp + q(2,4) = zero + q(3,4) = -59.0_wp/98.0_wp + q(4,4) = zero + q(5,4) = 32.0_wp/49.0_wp + q(6,4) = -4.0_wp/49.0_wp + + end subroutine coeffs_1_4_2 + + subroutine coeffs_up_4_2 ( a1, q1, a2, q2 ) + + CCTK_REAL, dimension(-2:2), intent(OUT) :: a1, a2 + CCTK_REAL, dimension(6,4), intent(OUT) :: q1, q2 + + a1(-2) = 0.1666666666666666666666666666666666666667_wp + a1(-1) = -1.0_wp + a1(0) = 0.5_wp + a1(1) = 0.3333333333333333333333333333333333333333_wp + a1(2) = zero + + q1(1,1) = -1.176470588235294117647058823529411764706_wp + q1(2,1) = 1.264705882352941176470588235294117647059_wp + q1(3,1) = zero + q1(4,1) = -0.08823529411764705882352941176470588235294_wp + q1(5,1) = zero + q1(6,1) = zero + + q1(1,2) = -0.6355932203389830508474576271186440677966_wp + q1(2,2) = 0.3389830508474576271186440677966101694915_wp + q1(3,2) = 0.2288135593220338983050847457627118644068_wp + q1(4,2) = 0.06779661016949152542372881355932203389831_wp + q1(5,2) = zero + q1(6,2) = zero + + q1(1,3) = 0.1860465116279069767441860465116279069767_wp + q1(2,3) = -1.058139534883720930232558139534883720930_wp + q1(3,3) = 0.5581395348837209302325581395348837209302_wp + q1(4,3) = 0.3139534883720930232558139534883720930233_wp + q1(5,3) = zero + q1(6,3) = zero + + q1(1,4) = 0.03061224489795918367346938775510204081633_wp + q1(2,4) = 0.08163265306122448979591836734693877551020_wp + q1(3,4) = -0.9285714285714285714285714285714285714286_wp + q1(4,4) = 0.4897959183673469387755102040816326530612_wp + q1(5,4) = 0.3265306122448979591836734693877551020408_wp + q1(6,4) = zero + + a2(-2) = zero + a2(-1) = -0.3333333333333333333333333333333333333333_wp + a2(0) = -0.5_wp + a2(1) = 1.0_wp + a2(2) = -0.1666666666666666666666666666666666666667_wp + + q2(1,1) = -1.647058823529411764705882352941176470588_wp + q2(2,1) = 2.205882352941176470588235294117647058824_wp + q2(3,1) = -0.4705882352941176470588235294117647058824_wp + q2(4,1) = -0.08823529411764705882352941176470588235294_wp + q2(5,1) = zero + q2(6,1) = zero + + q2(1,2) = -0.3644067796610169491525423728813559322034_wp + q2(2,2) = -0.3389830508474576271186440677966101694915_wp + q2(3,2) = 0.7711864406779661016949152542372881355932_wp + q2(4,2) = -0.06779661016949152542372881355932203389831_wp + q2(5,2) = zero + q2(6,2) = zero + + q2(1,3) = zero + q2(2,3) = -0.3139534883720930232558139534883720930233_wp + q2(3,3) = -0.5581395348837209302325581395348837209302_wp + q2(4,3) = 1.058139534883720930232558139534883720930_wp + q2(5,3) = -0.1860465116279069767441860465116279069767_wp + q2(6,3) = zero + + q2(1,4) = 0.03061224489795918367346938775510204081633_wp + q2(2,4) = -0.08163265306122448979591836734693877551020_wp + q2(3,4) = -0.2755102040816326530612244897959183673469_wp + q2(4,4) = -0.4897959183673469387755102040816326530612_wp + q2(5,4) = 0.9795918367346938775510204081632653061224_wp + q2(6,4) = -0.1632653061224489795918367346938775510204_wp + + end subroutine coeffs_up_4_2 + + subroutine coeffs_2_4_2 ( a, q ) + + CCTK_REAL, dimension(3), intent(OUT) :: a + CCTK_REAL, dimension(6,4), intent(OUT) :: q + + a(1) = -2.5_wp + a(2) = 1.333333333333333333333333333333333333333_wp + a(3) = -0.08333333333333333333333333333333333333333_wp + + q(1,1) = 2.282982974062943480262699765139082828341_wp + q(2,1) = -6.061186152736038050985124119271560606278_wp + q(3,1) = 5.414914870314717401313498825695414141704_wp + q(4,1) = -1.707457435157358700656749412847707070852_wp + q(5,1) = zero + q(6,1) = 0.07074574351573587006567494128477070708519_wp + + q(1,2) = 0.6942344983641924259873371181759910117504_wp + q(2,2) = -0.7761428473759173089500505257318397680987_wp + q(3,2) = -0.8377735941382550240731690788325510451097_wp + q(4,2) = 1.227832883028344666046439209128781626417_wp + q(5,2) = -0.3089460859592171540098546697125061038620_wp + q(6,2) = 0.0007951460808523949992979469721242789031010_wp + + q(1,3) = 0.4663616929151208330774297682981869862550_wp + q(2,3) = -1.149503303585047591170162224444663061895_wp + q(3,3) = 1.934396285188982033906351214796782385029_wp + q(4,3) = -2.569785963207868885472377980704238646268_wp + q(5,3) = 1.602587820613377868519202373305847453754_wp + q(6,3) = -0.2840565319245642588604431512519151168747_wp + + q(1,4) = -0.2658525795443897532890763269063473511119_wp + q(2,4) = 1.478411022421884393811018639563226856298_wp + q(3,4) = -2.255118294243640042353311289189433914072_wp + q(4,4) = 1.553414543643511297084585299252414115549_wp + q(5,4) = -0.9258553965216912759079296546576971585129_wp + q(6,4) = 0.4150007042443253806547133319378374518503_wp + + end subroutine coeffs_2_4_2 + + subroutine coeffs_1_6_3 ( a, q ) + + CCTK_REAL, dimension(3), intent(OUT) :: a + CCTK_REAL, dimension(9,6), intent(OUT) :: q + + a(1) = 3.0_wp/4.0_wp + a(2) = -3.0_wp/20.0_wp + a(3) = 1.0_wp/60.0_wp + + q(1,1) = -21600.0_wp/13649.0_wp + q(2,1) = 81763.0_wp/40947.0_wp + q(3,1) = 131.0_wp/27298.0_wp + q(4,1) = -9143.0_wp/13649.0_wp + q(5,1) = 20539.0_wp/81894.0_wp + q(6,1) = zero + q(7,1) = zero + q(8,1) = zero + q(9,1) = zero + + q(1,2) = -81763.0_wp/180195.0_wp + q(2,2) = zero + q(3,2) = 7357.0_wp/36039.0_wp + q(4,2) = 30637.0_wp/72078.0_wp + q(5,2) = -2328.0_wp/12013.0_wp + q(6,2) = 6611.0_wp/360390.0_wp + q(7,2) = zero + q(8,2) = zero + q(9,2) = zero + + q(1,3) = -131.0_wp/54220.0_wp + q(2,3) = -7357.0_wp/16266.0_wp + q(3,3) = zero + q(4,3) = 645.0_wp/2711.0_wp + q(5,3) = 11237.0_wp/32532.0_wp + q(6,3) = -3487.0_wp/27110.0_wp + q(7,3) = zero + q(8,3) = zero + q(9,3) = zero + + q(1,4) = 9143.0_wp/53590.0_wp + q(2,4) = -30637.0_wp/64308.0_wp + q(3,4) = -645.0_wp/5359.0_wp + q(4,4) = zero + q(5,4) = 13733.0_wp/32154.0_wp + q(6,4) = -67.0_wp/4660.0_wp + q(7,4) = 72.0_wp/5359.0_wp + q(8,4) = zero + q(9,4) = zero + + q(1,5) = -20539.0_wp/236310.0_wp + q(2,5) = 2328.0_wp/7877.0_wp + q(3,5) = -11237.0_wp/47262.0_wp + q(4,5) = -13733.0_wp/23631.0_wp + q(5,5) = zero + q(6,5) = 89387.0_wp/118155.0_wp + q(7,5) = -1296.0_wp/7877.0_wp + q(8,5) = 144.0_wp/7877.0_wp + q(9,5) = zero + + q(1,6) = zero + q(2,6) = -6611.0_wp/262806.0_wp + q(3,6) = 3487.0_wp/43801.0_wp + q(4,6) = 1541.0_wp/87602.0_wp + q(5,6) = -89387.0_wp/131403.0_wp + q(6,6) = zero + q(7,6) = 32400.0_wp/43801.0_wp + q(8,6) = -6480.0_wp/43801.0_wp + q(9,6) = 720.0_wp/43801.0_wp + + end subroutine coeffs_1_6_3 + + subroutine coeffs_1_6_3_opt ( a, q ) + + CCTK_REAL, dimension(3), intent(OUT) :: a + CCTK_REAL, dimension(9,6), intent(OUT) :: q + + a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp + + q(1,1) = -1.582533518939116418785258993332844897062_wp + q(2,1) = 2.033426786468126253898161347360808173712_wp + q(3,1) = -0.1417052898146741610733887894481170575600_wp + q(4,1) = -0.4501096599735708523162117824920488989702_wp + q(5,1) = 0.1042956382142412661862395105494407610836_wp + q(6,1) = 0.03662604404499391209045870736276191879693_wp + q(7,1) = zero + q(8,1) = zero + q(9,1) = zero + + q(1,2) = -0.4620701275035953590186631853846278325646_wp + q(2,2) = zero + q(3,2) = 0.2873679417026202568532985205129449923126_wp + q(4,2) = 0.2585974499280928196267362923074433487080_wp + q(5,2) = -0.06894808744606961472005221923058251153103_wp + q(6,2) = -0.01494717668104810274131940820517799692506_wp + q(7,2) = zero + q(8,2) = zero + q(9,2) = zero + + q(1,3) = 0.07134398748360337973038301686379010397038_wp + q(2,3) = -0.6366933020423417826592908754928085932593_wp + q(3,3) = zero + q(4,3) = 0.6067199374180168986519150843189505198519_wp + q(5,3) = -0.02338660408468356531858175098561718651857_wp + q(6,3) = -0.01798401877459493040442547470431484404443_wp + q(7,3) = zero + q(8,3) = zero + q(9,3) = zero + + q(1,4) = 0.1146397975178068401430112823144985150596_wp + q(2,4) = -0.2898424301162697370942324201800071793273_wp + q(3,4) = -0.3069262456316931913128086944558079603132_wp + q(4,4) = zero + q(5,4) = 0.5203848121857539166740071338174418292578_wp + q(6,4) = -0.05169127637022742348368508279860701098408_wp + q(7,4) = 0.01343534241462959507370778130248180630715_wp + q(8,4) = zero + q(9,4) = zero + + q(1,5) = -0.03614399304268576976452921364705641609825_wp + q(2,5) = 0.1051508663818248421520867474440761344449_wp + q(3,5) = 0.01609777419666805778308369351834662756172_wp + q(4,5) = -0.7080721616106272031118456849378369336023_wp + q(5,5) = zero + q(6,5) = 0.7692160858661111736140494493705980473867_wp + q(7,5) = -0.1645296432652024882569506157166433921544_wp + q(8,5) = 0.01828107147391138758410562396851593246160_wp + q(9,5) = zero + + q(1,6) = -0.01141318406360863692889821914555232596651_wp + q(2,6) = 0.02049729840293952857599941220163960606616_wp + q(3,6) = 0.01113095018331244864875173213474522093204_wp + q(4,6) = 0.06324365883611076515355091406993789453750_wp + q(5,6) = -0.6916640154753724474963890679085181638850_wp + q(6,6) = zero + q(7,6) = 0.7397091390607520376247117645715851236273_wp + q(8,6) = -0.1479418278121504075249423529143170247255_wp + q(9,6) = 0.01643798086801671194721581699047966941394_wp + + end subroutine coeffs_1_6_3_opt + + subroutine coeffs_up_6_3_opt ( a1, q1, a2, q2 ) + + CCTK_REAL, dimension(-3:3), intent(OUT) :: a1, a2 + CCTK_REAL, dimension(9,6), intent(OUT) :: q1, q2 + + a1(-3) = -0.03333333333333333333333333333333333333333_wp + a1(-2) = 0.2500000000000000000000000000000000000000_wp + a1(-1) = -1.000000000000000000000000000000000000000_wp + a1(0) = 0.3333333333333333333333333333333333333333_wp + a1(1) = 0.5000000000000000000000000000000000000000_wp + a1(2) = -0.05000000000000000000000000000000000000000_wp + a1(3) = zero + + q1(1,1) = -1.529782401641145871492417026888416733827_wp + q1(2,1) = 1.875173434574214612019635448027523684006_wp + q1(3,1) = 0.01654806207923748080513710988516743214616_wp + q1(4,1) = -0.5028607772715413996090537489364770622056_wp + q1(5,1) = 0.1042956382142412661862395105494407610836_wp + q1(6,1) = 0.03662604404499391209045870736276191879693_wp + q1(7,1) = zero + q1(8,1) = zero + q1(9,1) = zero + + q1(1,2) = -0.4980311697078740570957463452947252270539_wp + q1(2,2) = 0.1198701406809289935902771997003246482977_wp + q1(3,2) = 0.1435237728855054645449658808725554143554_wp + q1(4,2) = 0.3305195343366502157809026121276381376866_wp + q1(5,2) = -0.08093510151416251407907993920061497636080_wp + q1(6,2) = -0.01494717668104810274131940820517799692506_wp + q1(7,2) = zero + q1(8,2) = zero + q1(9,2) = zero + + q1(1,3) = 0.1510193840162481602541749755506215314879_wp + q1(2,3) = -0.9553948881729209047544587102401343033294_wp + q1(3,3) = 0.5046108447067502766506824050165990409443_wp + q1(4,3) = 0.2083429547547929960329552908847933822643_wp + q1(5,3) = 0.1359641889806059957290021663880456685165_wp + q1(6,3) = -0.04454248428547652391235612759992531988360_wp + q1(7,3) = zero + q1(8,3) = zero + q1(9,3) = zero + + q1(1,4) = 0.1012044551031772450693035010120167087525_wp + q1(2,4) = -0.2092303756284921666519857323651163414844_wp + q1(3,4) = -0.5084563818511371174184254139930350549204_wp + q1(4,4) = 0.2687068482925919014741556260496361261429_wp + q1(5,4) = 0.3188546759663099905683904142802147346506_wp + q1(6,4) = 0.02892077811755014695856160501628382685880_wp + q1(7,4) = zero + q1(8,4) = zero + q1(9,4) = zero + + q1(1,5) = -0.03614399304268576976452921364705641609825_wp + q1(2,5) = 0.08686979490791345456798112347556020198327_wp + q1(3,5) = 0.1257842030401363832877174373294422223313_wp + q1(4,5) = -0.9822882337192980168734300444655759205262_wp + q1(5,5) = 0.3656214294782277516821124793703186492319_wp + q1(6,5) = 0.4950000137574403598524650898428590604628_wp + q1(7,5) = -0.05484321442173416275231687190554779738479_wp + q1(8,5) = zero + q1(9,5) = zero + + q1(1,6) = -0.01141318406360863692889821914555232596651_wp + q1(2,6) = 0.02049729840293952857599941220163960606616_wp + q1(3,6) = -0.005307030684704263298464084855734448481896_wp + q1(4,6) = 0.1618715440442110368368458160128159110211_wp + q1(5,6) = -0.9382337284956231267046263227657132050941_wp + q1(6,6) = 0.3287596173603342389443163398095933882788_wp + q1(7,6) = 0.4931394260405013584164745097143900824182_wp + q1(8,6) = -0.04931394260405013584164745097143900824182_wp + q1(9,6) = zero + + a2(-3) = zero + a2(-2) = 0.05000000000000000000000000000000000000000_wp + a2(-1) = -0.5000000000000000000000000000000000000000_wp + a2(0) = -0.3333333333333333333333333333333333333333_wp + a2(1) = 1.000000000000000000000000000000000000000_wp + a2(2) = -0.2500000000000000000000000000000000000000_wp + a2(3) = 0.03333333333333333333333333333333333333333_wp + + q2(1,1) = -1.635284636237086966078100959777273060297_wp + q2(2,1) = 2.191680138362037895776687246694092663418_wp + q2(3,1) = -0.2999586417085858029519146887814015472662_wp + q2(4,1) = -0.3973585426756003050233698160476207357348_wp + q2(5,1) = 0.1042956382142412661862395105494407610836_wp + q2(6,1) = 0.03662604404499391209045870736276191879693_wp + q2(7,1) = zero + q2(8,1) = zero + q2(9,1) = zero + q2(1,2) = -0.4261090852993166609415800254745304380753_wp + q2(2,2) = -0.1198701406809289935902771997003246482977_wp + q2(3,2) = 0.4312121105197350491616311601533345702699_wp + q2(4,2) = 0.1866753655195354234725699724872485597294_wp + q2(5,2) = -0.05696107337797671536102449926055004670126_wp + q2(6,2) = -0.01494717668104810274131940820517799692506_wp + q2(7,2) = zero + q2(8,2) = zero + q2(9,2) = zero + q2(1,3) = -0.008331409049041400793408941823041323547141_wp + q2(2,3) = -0.3179917159117626605641230407454828831892_wp + q2(3,3) = -0.5046108447067502766506824050165990409443_wp + q2(4,3) = 1.005096920081240801270874877753107657440_wp + q2(5,3) = -0.1827373971499731263661656683592800415536_wp + q2(6,3) = 0.008574446736286663103505178191295631794744_wp + q2(7,3) = zero + q2(8,3) = zero + q2(9,3) = zero + q2(1,4) = 0.1280751399324364352167190636169803213668_wp + q2(2,4) = -0.3704544846040473075364791079948980171701_wp + q2(3,4) = -0.1053961094122492652071919749185808657060_wp + q2(4,4) = -0.2687068482925919014741556260496361261429_wp + q2(5,4) = 0.7219149484051978427796238533546689238650_wp + q2(6,4) = -0.1323033308580049939259317706134978488270_wp + q2(7,4) = 0.02687068482925919014741556260496361261429_wp + q2(8,4) = zero + q2(9,4) = zero + q2(1,5) = -0.03614399304268576976452921364705641609825_wp + q2(2,5) = 0.1234319378557362297361923714125920669065_wp + q2(3,5) = -0.09358865464680026772155005029274896720786_wp + q2(4,5) = -0.4338560895019563893502613254100979466783_wp + q2(5,5) = -0.3656214294782277516821124793703186492319_wp + q2(6,5) = 1.043432157974781987375633808898337034311_wp + q2(7,5) = -0.2742160721086708137615843595277389869240_wp + q2(8,5) = 0.03656214294782277516821124793703186492319_wp + q2(9,5) = zero + q2(1,6) = -0.01141318406360863692889821914555232596651_wp + q2(2,6) = 0.02049729840293952857599941220163960606616_wp + q2(3,6) = 0.02756893105132916059596754912522489034598_wp + q2(4,6) = -0.03538422637198950652974398787294012194614_wp + q2(5,6) = -0.4450943024551217682881518130513231226759_wp + q2(6,6) = -0.3287596173603342389443163398095933882788_wp + q2(7,6) = 0.9862788520810027168329490194287801648364_wp + q2(8,6) = -0.2465697130202506792082372548571950412091_wp + q2(9,6) = 0.03287596173603342389443163398095933882788_wp + + end subroutine coeffs_up_6_3_opt + + subroutine coeffs_1_8_4 ( a, q ) + + CCTK_REAL, dimension(4), intent(OUT) :: a + CCTK_REAL, dimension(12,8), intent(OUT) :: q + CCTK_REAL, parameter :: x1 = 0.541_wp, x2 = -0.0675_wp, x3 = 0.748_wp + + a(1) = 4.0_wp/5.0_wp + a(2) = -1.0_wp/5.0_wp + a(3) = 4.0_wp/105.0_wp + a(4) = -1.0_wp/280.0_wp + + q(1,1) = -2540160.0_wp/1498139.0_wp + q(2,1) = 9.0_wp * ( 2257920.0_wp*x1 + 11289600.0_wp*x2 + & + 22579200.0_wp*x3 - 15849163.0_wp ) / 5992556.0_wp + q(3,1) = 3.0_wp * ( -33868800.0_wp*x1 - 162570240.0_wp*x2 - & + 304819200.0_wp*x3 + 235236677.0_wp ) / 5992556.0_wp + q(4,1) = ( 609638400.0_wp*x1 + 2743372800.0_wp*x2 + & + 4572288000.0_wp * x3 - 3577778591.0_wp ) / 17977668.0_wp + q(5,1) = 3.0_wp * ( -16934400*x1 - 67737600.0_wp*x2 - & + 84672000.0_wp*x3 + 67906303.0_wp ) / 1498139.0_wp + q(6,1) = 105.0_wp * ( 967680.0_wp*x1 + 2903040.0_wp*x2 - & + 305821.0_wp ) / 5992556.0_wp + q(7,1) = 49.0_wp * ( -1244160.0_wp*x1 + 18662400.0_wp * x3 - & + 13322233.0_wp ) / 17977668.0_wp + q(8,1) = 3.0_wp * ( -6773760.0_wp*x2 - 33868800.0_wp*x3 + & + 24839327.0_wp ) / 5992556.0_wp + q(9,1) = zero + q(10,1) = zero + q(11,1) = zero + q(12,1) = zero + + q(1,2) = 9.0_wp * ( -2257920.0_wp*x1 - 11289600.0_wp*x2 - & + 22579200.0_wp*x3 + 15849163.0_wp ) / 31004596.0_wp + q(2,2) = zero + q(3,2) = 3.0_wp * ( 7257600.0_wp*x1 + 33868800.0_wp*x2 + & + 60963840.0_wp*x3 - 47167457.0_wp ) / 2214614.0_wp + q(4,2) = 3.0_wp * ( -9676800.0_wp*x1 - 42336000.0_wp*x2 - & + 67737600.0_wp*x3 + 53224573.0_wp ) / 1107307.0_wp + q(5,2) = 7.0_wp * ( 55987200.0_wp*x1 + 217728000.0_wp*x2 + & + 261273600.0_wp*x3 - 211102099.0_wp ) / 13287684.0_wp + q(6,2) = 3.0_wp * ( -11612160.0_wp*x1 - 33868800.0_wp*x2 + & + 3884117.0_wp ) / 2214614.0_wp + q(7,2) = 150.0_wp * ( 24192.0_wp*x1 - 338688.0_wp*x3 + & + 240463.0_wp ) / 1107307.0_wp + q(8,2) = ( 152409600.0_wp*x2 + 731566080.0_wp*x3 - & + 536324953.0_wp ) / 46506894.0_wp + q(9,2) = zero + q(10,2) = zero + q(11,2) = zero + q(12,2) = zero + + q(1,3) = ( 33868800.0_wp*x1 + 162570240.0_wp*x2 + & + 304819200.0_wp*x3 - 235236677.0_wp ) / 1743924.0_wp + q(2,3) = ( -7257600.0_wp*x1 - 33868800.0_wp*x2 - & + 60963840.0_wp*x3 + 47167457.0_wp ) / 124566.0_wp + q(3,3) = zero + q(4,3) = ( 24192000.0_wp*x1 + 101606400.0_wp*x2 + & + 152409600.0_wp*x3 - 120219461.0_wp ) / 124566.0_wp + q(5,3) = ( -72576000.0_wp*x1 - 270950400.0_wp*x2 - & + 304819200.0_wp*x3 + 249289259.0_wp ) / 249132.0_wp + q(6,3) = 9.0_wp * ( 806400.0_wp*x1 + 2257920.0_wp*x2 - & + 290167.0_wp ) / 41522.0_wp + q(7,3) = 6.0_wp * ( -134400.0_wp*x1 + 1693440.0_wp*x3 - & + 1191611.0_wp ) / 20761.0_wp + q(8,3) = 5.0_wp * ( -2257920.0_wp*x2 - 10160640.0_wp*x3 + & + 7439833.0_wp ) / 290654.0_wp + q(9,3) = zero + q(10,3) = zero + q(11,3) = zero + q(12,3) = zero + + q(1,4) = ( -609638400.0_wp*x1 - 2743372800.0_wp*x2 - & + 4572288000.0_wp*x3 + 3577778591.0_wp ) / 109619916.0_wp + q(2,4) = 3.0_wp * ( 9676800.0_wp*x1 + 42336000.0_wp*x2 + & + 67737600.0_wp*x3 - 53224573.0_wp ) / 1304999.0_wp + q(3,4) = 3.0_wp * ( -24192000.0_wp*x1 - 101606400.0_wp*x2 - & + 152409600.0_wp*x3 + 120219461.0_wp ) / 2609998.0_wp + q(4,4) = zero + q(5,4) = 9.0_wp * ( 16128000.0_wp*x1 + 56448000.0_wp*x2 + & + 56448000.0_wp*x3 - 47206049.0_wp ) / 5219996.0_wp + q(6,4) = 3.0_wp * ( -19353600.0_wp*x1 - 50803200.0_wp*x2 + & + 7628371.0_wp ) / 2609998.0_wp + q(7,4) = 2.0_wp * ( 10886400.0_wp*x1 - 114307200.0_wp*x3 + & + 79048289.0_wp ) / 3914997.0_wp + q(8,4) = 75.0_wp * ( 1354752.0_wp*x2 + 5419008.0_wp*x3 - & + 3952831.0_wp ) / 18269986.0_wp + q(9,4) = zero + q(10,4) = zero + q(11,4) = zero + q(12,4) = zero + + q(1,5) = 3.0_wp * ( 16934400.0_wp*x1 + 67737600.0_wp*x2 + & + 84672000.0_wp*x3 - 67906303.0_wp ) / 2096689.0_wp + q(2,5) = 7.0_wp * ( -55987200.0_wp*x1 - 217728000.0_wp*x2 - & + 261273600.0_wp*x3 + 211102099.0_wp ) / 3594324.0_wp + q(3,5) = 3.0_wp * ( 72576000.0_wp*x1 + 270950400.0_wp*x2 + & + 304819200.0_wp*x3 - 249289259.0_wp ) / 1198108.0_wp + q(4,5) = 9.0_wp * ( -16128000.0_wp*x1 - 56448000.0_wp*x2 - & + 56448000.0_wp*x3 + 47206049.0_wp ) / 1198108.0_wp + q(5,5) = zero + q(6,5) = 105.0_wp * ( 414720.0_wp*x1 + 967680.0_wp*x2 - & + 165527.0_wp ) / 1198108.0_wp + q(7,5) = 15.0_wp * ( -967680.0_wp*x1 + 6773760.0_wp*x3 - & + 4472029.0_wp ) / 1198108.0_wp + q(8,5) = ( -304819200.0_wp*x2 - 914457600.0_wp*x3 + & + 657798011.0_wp ) / 25160268.0_wp + q(9,5) = -2592.0_wp/299527.0_wp; + q(10,5) = zero + q(11,5) = zero + q(12,5) = zero + + q(1,6) = 5.0_wp * ( -967680.0_wp*x1 - 2903040.0_wp*x2 + & + 305821.0_wp ) / 1237164.0_wp + q(2,6) = ( 11612160.0_wp*x1 + 33868800.0_wp*x2 - & + 3884117.0_wp ) / 618582.0_wp + q(3,6) = 9.0_wp * ( -806400.0_wp*x1 - 2257920.0_wp*x2 + & + 290167.0_wp ) / 206194.0_wp + q(4,6) = ( 19353600.0_wp*x1 + 50803200.0_wp*x2 - & + 7628371.0_wp ) / 618582.0_wp + q(5,6) = 35.0_wp * ( -414720.0_wp*x1 - 967680.0_wp*x2 + & + 165527.0_wp ) / 1237164.0_wp + q(6,6) = zero + q(7,6) = 80640.0_wp*x1 / 103097.0_wp + q(8,6) = 80640.0_wp*x2 / 103097.0_wp + q(9,6) = 3072.0_wp / 103097.0_wp + q(10,6) = -288.0_wp/103097.0_wp + q(11,6) = zero + q(12,6) = zero + + q(1,7) = 7.0_wp * ( 1244160.0_wp*x1 - 18662400.0_wp*x3 + & + 13322233.0_wp ) / 8041092.0_wp + q(2,7) = 150.0_wp * ( -24192.0_wp*x1 + 338688.0_wp*x3 - & + 240463.0_wp ) / 670091.0_wp + q(3,7) = 54.0_wp * ( 134400.0_wp*x1 - 1693440.0_wp*x3 + & + 1191611.0_wp ) / 670091.0_wp + q(4,7) = 2.0_wp * ( -10886400.0_wp*x1 + 114307200.0_wp*x3 - & + 79048289.0_wp ) / 2010273.0_wp + q(5,7) = 15.0_wp * ( 967680.0_wp*x1 - 6773760.0_wp*x3 + & + 4472029.0_wp ) / 2680364.0_wp + q(6,7) = -725760.0_wp*x1 / 670091.0_wp + q(7,7) = zero + q(8,7) = 725760.0_wp*x3 / 670091.0_wp + q(9,7) = -145152.0_wp/670091.0_wp + q(10,7) = 27648.0_wp/670091.0_wp + q(11,7) = -2592.0_wp/670091.0_wp + q(12,7) = zero + + q(1,8) = 3.0_wp * ( 6773760.0_wp*x2 + 33868800.0_wp*x3 - & + 24839327.0_wp ) / 20510956.0_wp + q(2,8) = ( -152409600.0_wp*x2 - 731566080.0_wp*x3 + & + 536324953.0_wp ) / 30766434.0_wp + q(3,8) = 45.0_wp * ( 2257920.0_wp*x2 + 10160640.0_wp*x3 - & + 7439833.0_wp ) / 10255478.0_wp + q(4,8) = 75.0_wp * ( -1354752.0_wp*x2 - 5419008.0_wp*x3 + & + 3952831.0_wp ) / 10255478.0_wp + q(5,8) = ( 304819200.0_wp*x2 + 914457600.0_wp*x3 - & + 657798011.0_wp ) / 61532868.0_wp + q(6,8) = -5080320.0_wp*x2 / 5127739.0_wp + q(7,8) = -5080320.0_wp*x3 / 5127739.0_wp + q(8,8) = zero + q(9,8) = 4064256.0_wp/5127739.0_wp + q(10,8) = -1016064.0_wp/5127739.0_wp + q(11,8) = 193536.0_wp/5127739.0_wp + q(12,8) = -18144.0_wp/5127739.0_wp + + end subroutine coeffs_1_8_4 + + subroutine coeffs_1_8_4_opt ( a, q ) + + CCTK_REAL, dimension(4), intent(OUT) :: a + CCTK_REAL, dimension(12,8), intent(OUT) :: q + + a(1) = 4.0_wp/5.0_wp + a(2) = -1.0_wp/5.0_wp + a(3) = 4.0_wp/105.0_wp + a(4) = -1.0_wp/280.0_wp + + q(1,1) = -1.695543604431898508749855654248370812054_wp + q(2,1) = 2.244525109969933844775276252674718713114_wp + q(3,1) = -0.002163206607021876385102025416828692597556_wp + q(4,1) = -0.8963677947307838167920190976769921451579_wp + q(5,1) = 0.2272938673777916084251861567415263328923_wp + q(6,1) = 0.1564962758424078514454013191006671546757_wp + q(7,1) = 0.003067629343740613524557473056482141287158_wp + q(8,1) = -0.03730827676416971624344442423120269215938_wp + q(9,1) = zero + q(10,1) = zero + q(11,1) = zero + q(12,1) = zero + + q(1,2) = -0.4338209217401506177055540526837828066711_wp + q(2,2) = zero + q(3,2) = 0.06631961192627293470305188523936353462439_wp + q(4,2) = 0.6021342012739069461791324177355805603656_wp + q(5,2) = -0.2213339967864188453859900127368926875520_wp + q(6,2) = -0.001759980003751516130708214237001705688807_wp + q(7,2) = -0.03586646217917856587352426166797879385310_wp + q(8,2) = 0.02432754750931966421359223835071189877503_wp + q(9,2) = zero + q(10,2) = zero + q(11,2) = zero + q(12,2) = zero + + q(1,3) = 0.002477771724790106958560398469919805908522_wp + q(2,3) = -0.3930241559935857537756812928554282732813_wp + q(3,3) = zero + q(4,3) = -0.6080263371305341035810612202824357742461_wp + q(5,3) = 2.372533124692864412954923458457782022478_wp + q(6,3) = -2.126112217612194556872952028715623246817_wp + q(7,3) = 0.9075309435559160631495435310307745215131_wp + q(8,3) = -0.1553791292372561688333328461049890555549_wp + q(9,3) = zero + q(10,3) = zero + q(11,3) = zero + q(12,3) = zero + + q(1,4) = 0.1470043328582935680963279007411074464266_wp + q(2,4) = -0.5109179516689331400658365102850902594996_wp + q(3,4) = 0.08705685833207777685654755900085198684605_wp + q(4,4) = zero + q(5,4) = -0.1306945333157231839535552435788086367322_wp + q(6,4) = 0.5981933016362239542598518794410035592720_wp + q(7,4) = -0.2031099149801233772210520666270517105660_wp + q(8,4) = 0.01246790713818440202771648130798761425319_wp + q(9,4) = zero + q(10,4) = zero + q(11,4) = zero + q(12,4) = zero + + q(1,5) = -0.1624073990846984662267508265053107632238_wp + q(2,5) = 0.8182390368133059538132603839842499379861_wp + q(3,5) = -1.480018301574606037840376638130713134769_wp + q(4,5) = 0.5694185675497882973361521309100738568707_wp + q(5,5) = zero + q(6,5) = 0.02929508293831017534661096502884570435894_wp + q(7,5) = 0.2825910005984090924748504462528740123097_wp + q(8,5) = -0.04846434332860791750685068920563907354793_wp + q(9,5) = -0.008653643911901097396895772334380539984709_wp + q(10,5) = zero + q(11,5) = zero + q(12,5) = zero + + q(1,6) = -0.03609686950604370828405582087760384548297_wp + q(2,6) = 0.002100328577309696555612805397001149641337_wp + q(3,6) = 0.4281425817419204360479874008765051769418_wp + q(4,6) = -0.8413238238875046736839550701643761633826_wp + q(5,6) = -0.009456755727630000971085851751473603919416_wp + q(6,6) = zero + q(7,6) = 0.5172389789041733771234394082779034212042_wp + q(8,6) = -0.08760813565107717873901807278223424202774_wp + q(9,6) = 0.02979718129528502284256573906127239395909_wp + q(10,6) = -0.002793485746432970891490538036994286933664_wp + q(11,6) = zero + q(12,6) = zero + + q(1,7) = -0.0009797678134978722516935350416937185004514_wp + q(2,7) = 0.05926834509975463070197111976550139351983_wp + q(3,7) = -0.2530570463899371286637621744353665227114_wp + q(4,7) = 0.3955555826583941989223787901885502942688_wp + q(5,7) = -0.1263166266018192756531792392597193430222_wp + q(6,7) = -0.7162192643577544899896537844517283192029_wp + q(7,7) = zero + q(8,7) = 0.8209721963136350137518635528607308559584_wp + q(9,7) = -0.2166153552278720352907291696202456084323_wp + q(10,7) = 0.04126006766245181624585317516576106827282_wp + q(11,7) = -0.003868131343354857773048735171790100150577_wp + q(12,7) = zero + + q(1,8) = 0.01090012273307913185972171872891927027272_wp + q(2,8) = -0.03677379943661633440187210478144113487019_wp + q(3,8) = 0.03963287609450569641558898819403594845401_wp + q(4,8) = -0.02221139656912423686782339404035534965598_wp + q(5,8) = 0.01981665906734246925389947980969432794418_wp + q(6,8) = 0.1109698768905366566973791789571759073485_wp + q(7,8) = -0.7509903604688148129224205834189298636300_wp + q(8,8) = zero + q(9,8) = 0.7926019635554773751160111698352821779736_wp + q(10,8) = -0.1981504908888693437790027924588205444934_wp + q(11,8) = 0.03774295064549892262457196046834677037969_wp + q(12,8) = -0.003538401623015523996053621293907509723096_wp + + end subroutine coeffs_1_8_4_opt + + subroutine coeffs_up_8_4_opt ( a1, q1, a2, q2 ) + + CCTK_REAL, dimension(-4:4), intent(OUT) :: a1, a2 + CCTK_REAL, dimension(12,8), intent(OUT) :: q1, q2 + + a1(-4) = 0.007142857142857142857142857142857142857143_wp + a1(-3) = -0.06666666666666666666666666666666666666667_wp + a1(-2) = 0.3_wp + a1(-1) = -1.0_wp + a1(0) = 0.25_wp + a1(1) = 0.6_wp + a1(2) = -0.1_wp + a1(3) = 0.009523809523809523809523809523809523809524_wp + a1(4) = zero + + q1(1,1) = -1.683432578685956376544499542432311020539_wp + q1(2,1) = 2.206194911574014373726323572790957192479_wp + q1(3,1) = 0.01048240012328238642042347285056590509052_wp + q1(4,1) = -0.7964177278055455600674641925035752355813_wp + q1(5,1) = 0.04375559918421074726330123748705042737925_wp + q1(6,1) = 0.3015760468426855559502835132688146245819_wp + q1(7,1) = -0.05430139927462465206917597295687512552949_wp + q1(8,1) = -0.02785725195806647467919208850462676788091_wp + q1(9,1) = zero + q1(10,1) = zero + q1(11,1) = zero + q1(12,1) = zero + + q1(1,2) = -0.4451389901846271204230470438663315357999_wp + q1(2,2) = 0.03979384217746298000464189244717138065595_wp + q1(3,2) = 0.04117629055092890361160914968898310705568_wp + q1(4,2) = 0.5200531283081606472663885367960872642342_wp + q1(5,2) = -0.04132093916257534380117029102933732094903_wp + q1(6,2) = -0.1571076966553020594965523100929511511562_wp + q1(7,2) = 0.02929412303865500620649355002594213960776_wp + q1(8,2) = 0.01325024192729698663163651603043611635147_wp + q1(9,2) = zero + q1(10,2) = zero + q1(11,2) = zero + q1(12,2) = zero + + q1(1,3) = 0.1544592597396873173299548977341719367844_wp + q1(2,3) = -1.020860666961436408391054234781341175626_wp + q1(3,3) = 0.7352247001589518809305910119936419247628_wp + q1(4,3) = -0.1443377614671085870438942853092495421459_wp + q1(5,3) = 0.4029099592852542668089969628980513126845_wp + q1(6,3) = -0.1256847607545176255327746274725689708913_wp + q1(7,3) = -0.01218362768224537680217842793138395523727_wp + q1(8,3) = 0.01047289768141453270035870286867846966855_wp + q1(9,3) = zero + q1(10,3) = zero + q1(11,3) = zero + q1(12,3) = zero + + q1(1,4) = 0.1147228529148158318034738218073197976023_wp + q1(2,4) = -0.3538780254601914958115698874206531961307_wp + q1(3,4) = -0.1858994785495101740456777336107169678288_wp + q1(4,4) = 0.1370483808799853486477767415913728669524_wp + q1(5,4) = 0.03972858582710281564215102156521588367881_wp + q1(6,4) = 0.3165092134256211709442618752193670178495_wp + q1(7,4) = -0.05069213274750316093259254157360772183295_wp + q1(8,4) = -0.01753939629032033624782329757829768029059_wp + q1(9,4) = zero + q1(10,4) = zero + q1(11,4) = zero + q1(12,4) = zero + + q1(1,5) = -0.01395722952056041916292538026746562805620_wp + q1(2,5) = 0.01429909551156929498323180030121632055909_wp + q1(3,5) = 0.2332633686362482363893930312775209255800_wp + q1(4,5) = -1.142300242635165935993053851544552454320_wp + q1(5,5) = 0.6057550738330768177827040634066377989296_wp + q1(6,5) = 0.2825179352075121763892365873707254541218_wp + q1(7,5) = 0.03248906901967492013975174489420235738435_wp + q1(8,5) = -0.01206707005235509052833799543828477419916_wp + q1(9,5) = zero + q1(10,5) = zero + q1(11,5) = zero + q1(12,5) = zero + + q1(1,6) = -0.06956044896551484587496684695381321009857_wp + q1(2,6) = 0.1930764794969705526456194423505107491362_wp + q1(3,6) = -0.01938619631973248083178041998353003089641_wp + q1(4,6) = -0.2887164590533642022788579933885334942677_wp + q1(5,6) = -0.4040701147451219074780049288053335780831_wp + q1(6,6) = 0.1955440022503079624043376625896000853565_wp + q1(7,6) = 0.4088327186474708718613662440475307694516_wp + q1(8,6) = -0.02316927663483720615835459462174938908831_wp + q1(9,6) = 0.007449295323821255710641434765318098489772_wp + q1(10,6) = zero + q1(11,6) = zero + q1(12,6) = zero + + q1(1,7) = 0.01734328280101122760645584447264624051821_wp + q1(2,7) = -0.04840773491893482968357096782164797435370_wp + q1(3,7) = 0.01113356043999974094579726795398111697087_wp + q1(4,7) = 0.03683258325116868830333840353178374785556_wp + q1(5,7) = 0.2020929196538139300412937632456998385290_wp + q1(6,7) = -0.9993401510385675084229179036326626049945_wp + q1(7,7) = 0.2707691940348400441134114620253070105404_wp + q1(8,7) = 0.6075690064749917706800934212435751620821_wp + q1(9,7) = -0.1083076776139360176453645848101228042161_wp + q1(10,7) = 0.01031501691561295406146329379144026706820_wp + q1(11,7) = zero + q1(12,7) = zero + + q1(1,8) = 0.008138876723484902470545040666116789759842_wp + q1(2,8) = -0.02002921745130282774392822052620050919550_wp + q1(3,8) = -0.002671343688148396036480262140129972226295_wp + q1(4,8) = 0.03832298452325717814060194729385919629895_wp + q1(5,8) = -0.05168030333817646678101782026786038350804_wp + q1(6,8) = 0.2274981280312773565363597229555297756596_wp + q1(7,8) = -0.9520792032950265164134838698189786312337_wp + q1(8,8) = 0.2476881136110866797237534905735256806167_wp + q1(9,8) = 0.5944514726666080313370083773764616334802_wp + q1(10,8) = -0.09907524544443467188950139622941027224670_wp + q1(11,8) = 0.009435737661374730656142990117086692594923_wp + q1(12,8) = zero + + a2(-4) = zero + a2(-3) = -0.009523809523809523809523809523809523809524_wp + a2(-2) = 0.1000000000000000000000000000000000000000_wp + a2(-1) = -0.6000000000000000000000000000000000000000_wp + a2(0) = -0.2500000000000000000000000000000000000000_wp + a2(1) = 1.000000000000000000000000000000000000000_wp + a2(2) = -0.3000000000000000000000000000000000000000_wp + a2(3) = 0.06666666666666666666666666666666666666667_wp + a2(4) = -0.007142857142857142857142857142857142857143_wp + + q2(1,1) = -1.707654630177840640955211766064430603569_wp + q2(2,1) = 2.303083117541551431369172467319435524597_wp + q2(3,1) = -0.1348499088280232000438498689421515930856_wp + q2(4,1) = -0.6995295218380085024246152979750969034639_wp + q2(5,1) = 0.01953354769232648285258901385493084434991_wp + q2(6,1) = 0.3015760468426855559502835132688146245819_wp + q2(7,1) = -0.05430139927462465206917597295687512552949_wp + q2(8,1) = -0.02785725195806647467919208850462676788091_wp + q2(9,1) = zero + q2(10,1) = zero + q2(11,1) = zero + q2(12,1) = zero + + q2(1,2) = -0.4264124762187621886561567415382508860795_wp + q2(2,2) = -0.03979384217746298000464189244717138065595_wp + q2(3,2) = 0.1722618883119834259798412659855476550988_wp + q2(4,2) = 0.4170573014959035225484918739916436907718_wp + q2(5,2) = -0.003867911230845480267389686373176021508129_wp + q2(6,2) = -0.1617893251467682924382748856749713135863_wp + q2(7,2) = 0.02929412303865500620649355002594213960776_wp + q2(8,2) = 0.01325024192729698663163651603043611635147_wp + q2(9,2) = zero + q2(10,2) = zero + q2(11,2) = zero + q2(12,2) = zero + + q2(1,3) = -0.01200671010762254250338646347193566882227_wp + q2(2,3) = -0.2440194743406570625021278824861723494614_wp + q2(3,3) = -0.7352247001589518809305910119936419247628_wp + q2(4,3) = 1.298367310542910198178397511810349706445_wp + q2(5,3) = -0.3739312333355250790799293893971175134799_wp + q2(6,3) = 0.09626986570856218757834718746890783658430_wp + q2(7,3) = -0.03992795599013035344106865479906855617172_wp + q2(8,3) = 0.01047289768141453270035870286867846966855_wp + q2(9,3) = zero + q2(10,3) = zero + q2(11,3) = zero + q2(12,3) = zero + + q2(1,4) = 0.1306125202632199301974189512671891155098_wp + q2(2,4) = -0.4412711958764140369782680994499344446221_wp + q2(3,4) = 0.02066619697974310507560894936758416496903_wp + q2(4,4) = -0.1370483808799853486477767415913728669524_wp + q2(5,4) = 0.2621839287047601931573828340033863343841_wp + q2(6,4) = 0.2052815419867924821866459690002817924969_wp + q2(7,4) = -0.01891279805069496414470228265386908601791_wp + q2(8,4) = -0.02151181312742136084630957994326500976747_wp + q2(9,4) = zero + q2(10,4) = zero + q2(11,4) = zero + q2(12,4) = zero + + q2(1,5) = -0.03126451734436261395671692493622670802562_wp + q2(2,5) = 0.1527573981019868533335641576513049603144_wp + q2(3,5) = -0.2513406904302132178367702194477893135637_wp + q2(4,5) = -0.1730921245022430275407273500939319760321_wp + q2(5,5) = -0.6057550738330768177827040634066377989296_wp + q2(6,5) = 1.251726053340435084841563088821345932409_wp + q2(7,5) = -0.4521149900467865340864115058311078817594_wp + q2(8,5) = 0.1263912325380624678219943619118038655562_wp + q2(9,5) = -0.01730728782380219479379154466876107996942_wp + q2(10,5) = zero + q2(11,5) = zero + q2(12,5) = zero + + q2(1,6) = -0.06956044896551484587496684695381321009857_wp + q2(2,6) = 0.1874895080041046108626383662765221752689_wp + q2(3,6) = 0.02530957562319505343206818860837856004222_wp + q2(4,6) = -0.4451516608536105722023281234602135625529_wp + q2(5,6) = -0.09119971114462916763106466866197344151272_wp + q2(6,6) = -0.1955440022503079624043376625896000853565_wp + q2(7,6) = 0.7217031222479636117083065041908909060220_wp + q2(8,6) = -0.1796044784350835760818247246934294573735_wp + q2(9,6) = 0.05214506726674878997449004335722668942840_wp + q2(10,6) = -0.005586971492865941782981076073988573867329_wp + q2(11,6) = zero + q2(12,6) = zero + + q2(1,7) = 0.01734328280101122760645584447264624051821_wp + q2(2,7) = -0.04840773491893482968357096782164797435370_wp + q2(3,7) = 0.003397297753290025399699797610400916669720_wp + q2(4,7) = 0.09872268474484641267211816628042535026479_wp + q2(5,7) = -0.01452243557405810524943540637454576990329_wp + q2(6,7) = -0.5661094405828234378414595643921713881299_wp + q2(7,7) = -0.2707691940348400441134114620253070105404_wp + q2(8,7) = 1.040799716930735841261551760484066378947_wp + q2(9,7) = -0.3249230328418080529360937544303684126484_wp + q2(10,7) = 0.07220511840929067843024305654008186947743_wp + q2(11,7) = -0.007736262686709715546097470343580200301153_wp + q2(12,7) = zero + + q2(1,8) = 0.008138876723484902470545040666116789759842_wp + q2(2,8) = -0.02002921745130282774392822052620050919550_wp + q2(3,8) = -0.002671343688148396036480262140129972226295_wp + q2(4,8) = 0.03124618127722613014849470470604417685276_wp + q2(5,8) = 0.004934122630071917155840120434659772061498_wp + q2(6,8) = 0.02934763714240801275735693049670923116616_wp + q2(7,8) = -0.5557782215172878288554782849013375422469_wp + q2(8,8) = -0.2476881136110866797237534905735256806167_wp + q2(9,8) = 0.9907524544443467188950139622941027224670_wp + q2(10,8) = -0.2972257363333040156685041886882308167401_wp + q2(11,8) = 0.06605016362962311459300093081960684816446_wp + q2(12,8) = -0.007076803246031047992107242587815019446193_wp + + end subroutine coeffs_up_8_4_opt + + subroutine coeffs_1_4_3 ( a, q ) + + CCTK_REAL, dimension(2), intent(OUT) :: a + CCTK_REAL, dimension(7,5), intent(OUT) :: q + CCTK_REAL :: f0, f1, f2, f3 + + a(1) = 2.0_wp/3.0_wp + a(2) = -1.0_wp/12.0_wp + + f0 = sqrt(26116897.0_wp) + f1 = -56764003702447356523.0_wp + 8154993476273221.0_wp * f0 + f2 = -55804550303.0_wp + 9650225.0_wp * f0 + f3 = 3262210757.0_wp + 271861.0_wp * f0 + + q(1,1) = -11._wp/6.0_wp + q(2,1) = 3.0_wp + q(3,1) = -3.0_wp/2.0_wp + q(4,1) = 1.0_wp/3.0_wp + q(5,1) = zero + q(6,1) = zero + q(7,1) = zero + + q(1,2) = -24.0_wp * ( -779042810827742869.0_wp + & + 104535124033147.0_wp * f0 ) / f1 + q(2,2) = -( -176530817412806109689.0_wp + & + 29768274816875927.0_wp * f0 ) / ( 6.0_wp * f1 ) + q(3,2) = 343.0_wp * ( -171079116122226871.0_wp + & + 27975630462649.0_wp * f0 ) / f1 + q(4,2) = -3.0_wp * ( -7475554291248533227.0_wp + & + 1648464218793925.0_wp * f0 ) / ( 2.0_wp * f1 ) + q(5,2) = ( -2383792768180030915.0_wp + & + 1179620587812973.0_wp * f0 ) / ( 3.0_wp * f1 ) + q(6,2) = -1232.0_wp * ( -115724529581315.0_wp + & + 37280576429.0_wp * f0 ) / f1 + q(7,2) = zero + + q(1,3) = -12.0_wp * ( -380966843.0_wp + 86315.0_wp * f0 ) / f2 + q(2,3) = ( 5024933015.0_wp + 2010631.0_wp * f0 ) / ( 3.0_wp * f2 ) + q(3,3) = -231.0_wp * ( -431968921.0_wp + & + 86711.0_wp * f0 ) / ( 2.0_wp * f2 ) + q(4,3) = ( -65931742559.0_wp + 12256337.0_wp * f0 ) / f2 + q(5,3) = -( -50597298167.0_wp + 9716873.0_wp * f0 ) / ( 6.0_wp * f2 ) + q(6,3) = -88.0_wp * ( -15453061.0_wp + 2911.0_wp * f0 ) / f2 + q(7,3) = zero + + q(1,4) = 48.0_wp * ( -56020909845192541.0_wp + & + 9790180507043.0_wp * f0 ) / f1 + q(2,4) = ( -9918249049237586011.0_wp + & + 1463702013196501.0_wp * f0 ) / ( 6.0_wp * f1) + q(3,4) = -13.0_wp * ( -4130451756851441723.0_wp + & + 664278707201077.0_wp * f0 ) / f1 + q(4,4) = 3.0_wp * ( -26937108467782666617.0_wp + & + 5169063172799767.0_wp * f0 ) / ( 2.0_wp * f1 ) + q(5,4) = -( 6548308508012371315.0_wp + & + 3968886380989379.0_wp * f0 ) / ( 3.0_wp * f1 ) + q(6,4) = 88.0_wp * ( -91337851897923397.0_wp + & + 19696768305507.0_wp * f0 ) / f1 + q(7,4) = 242.0_wp * ( -120683.0_wp + 15.0_wp * f0 ) / f3 + + q(1,5) = 264.0_wp * ( -120683.0_wp + 15.0_wp * f0 ) / f3 + q(2,5) = ( -43118111.0_wp + 23357.0_wp * f0 ) / ( 3.0_wp * f3 ) + q(3,5) = -47.0_wp * ( -28770085.0_wp + 2259.0_wp * f0 ) / ( 2.0_wp * f3 ) + q(4,5) = -3.0_wp * ( 1003619433.0_wp + 11777.0_wp * f0 ) / f3 + q(5,5) = -11.0_wp * ( -384168269.0_wp + & + 65747.0_wp * f0 ) / ( 6.0_wp * f3 ) + q(6,5) = 22.0_wp * ( 87290207.0_wp + 10221.0_wp * f0 ) / f3 + q(7,5) = -66.0_wp * ( 3692405.0_wp + 419.0_wp * f0 ) / f3 + + end subroutine coeffs_1_4_3 + + subroutine coeffs_1_4_3_opt ( a, q ) + + CCTK_REAL, dimension(2), intent(OUT) :: a + CCTK_REAL, dimension(7,5), intent(OUT) :: q + + a(1) = 2.0_wp/3.0_wp + a(2) = -1.0_wp/12.0_wp + + q(1,1) = -2.09329763466349871588733_wp + q(2,1) = 4.0398572053206615302160_wp + q(3,1) = -3.0597858079809922953240_wp + q(4,1) = 1.37319053865399486354933_wp + q(5,1) = -0.25996430133016538255400_wp + q(6,1) = zero + q(7,1) = zero + + q(1,2) = -0.31641585285940445272297_wp + q(2,2) = -0.53930788973980422327388_wp + q(3,2) = 0.98517732028644343383297_wp + q(4,2) = -0.05264665989297578146709_wp + q(5,2) = -0.113807251750624235013258_wp + q(6,2) = 0.039879767889849911803103_wp + q(7,2) = -0.0028794339334846531588787_wp + + q(1,3) = 0.13026916185021164524452_wp + q(2,3) = -0.87966858995059249256890_wp + q(3,3) = 0.38609640961100070000134_wp + q(4,3) = 0.31358369072435588745988_wp + q(5,3) = 0.085318941913678384633511_wp + q(6,3) = -0.039046615792734640274641_wp + q(7,3) = 0.0034470016440805155042908_wp + + q(1,4) = -0.01724512193824647912172_wp + q(2,4) = 0.16272288227127504381134_wp + q(3,4) = -0.81349810248648813029217_wp + q(4,4) = 0.13833269266479833215645_wp + q(5,4) = 0.59743854328548053399616_wp + q(6,4) = -0.066026434346299887619324_wp + q(7,4) = -0.0017244594505194129307249_wp + + q(1,5) = -0.00883569468552192965061_wp + q(2,5) = 0.03056074759203203857284_wp + q(3,5) = 0.05021168274530854232278_wp + q(4,5) = -0.66307364652444929534068_wp + q(5,5) = 0.014878787464005191116088_wp + q(6,5) = 0.65882706381707471953820_wp + q(7,5) = -0.082568940408449266558615_wp + + end subroutine coeffs_1_4_3_opt + + subroutine coeffs_1_6_5 ( a, q ) + + CCTK_REAL, dimension(3), intent(OUT) :: a + CCTK_REAL, dimension(10,7), intent(OUT) :: q + + a(1) = 3.0_wp/4.0_wp + a(2) = -3.0_wp/20.0_wp + a(3) = 1.0_wp/60.0_wp + + q(1,1) = -137.0_wp/60.0_wp + q(2,1) = 5.0_wp + q(3,1) = -5.0_wp + q(4,1) = 10.0_wp/3.0_wp + q(5,1) = -5.0_wp/4.0_wp + q(6,1) = 1.0_wp/5.0_wp + q(7,1) = zero + q(8,1) = zero + q(9,1) = zero + q(10,1) = zero + + q(1,2) = -0.3209098489859668118347_wp + q(2,2) = -0.359441670715467075894_wp + q(3,2) = 0.195756852998105503889_wp + q(4,2) = 1.394685510250317033169_wp + q(5,2) = -1.448965775497476572821_wp + q(6,2) = 0.6519476244467816674835_wp + q(7,2) = -0.1115052611983591304249_wp + q(8,2) = -0.00156743129793461356831_wp + q(9,2) = zero + q(10,2) = zero + + q(1,3) = 0.0980796259621024870281_wp + q(2,3) = -0.784752101846956387607_wp + q(3,3) = 0.364206221878666751300_wp + q(4,3) = 0.102097753636344358379_wp + q(5,3) = 0.377167650934576412896_wp + q(6,3) = -0.173241400242683302020_wp + q(7,3) = 0.0062120424243610783650_wp + q(8,3) = 0.01153111791917461507898_wp + q(9,3) = -0.00130091066558601341956_wp + q(10,3) = zero + + q(1,4) = 0.0771947815148234674634_wp + q(2,4) = -0.4124719432622107102831_wp + q(3,4) = 0.654798717867622763906_wp + q(4,4) = -1.873474657556531216053_wp + q(5,4) = 2.161961221935152129759_wp + q(6,4) = -0.729147814207596325277_wp + q(7,4) = 0.1292509053479867634674_wp + q(8,4) = -0.01092898521375837831427_wp + q(9,4) = 0.00316983426828354261009_wp + q(10,4) = -0.000352060693772037278516_wp + + q(1,5) = -0.01135836398682271847110_wp + q(2,5) = 0.0114974985688122284189_wp + q(3,5) = 0.228765565489867047381_wp + q(4,5) = -1.179122428698534075609_wp + q(5,5) = 0.774618306056840861215_wp + q(6,5) = 0.016612403904600041087_wp + q(7,5) = 0.2399304273448163041220_wp + q(8,5) = -0.0959180672407791626759_wp + q(9,5) = 0.01612460763754670343830_wp + q(10,5) = -0.001149949076347228906108_wp + + q(1,6) = -0.01912046962023373131259_wp + q(2,6) = 0.1569245474161812198493_wp + q(3,6) = -0.567250839387340928718_wp + q(4,6) = 1.230411310316952671353_wp + q(5,6) = -2.048795717924254691221_wp + q(6,6) = 0.982715833107347313532_wp + q(7,6) = 0.2876584784911885215053_wp + q(8,6) = -0.0207657038198929292487_wp + q(9,6) = -0.00335290957957120811713_wp + q(10,6) = 0.001575470999623762377395_wp + + q(1,7) = -0.0076072322555736921424_wp + q(2,7) = 0.034503414345314189270_wp + q(3,7) = -0.044377233426986476366_wp + q(4,7) = -0.049408595803628143797_wp + q(5,7) = 0.304693537653175477283_wp + q(6,7) = -0.935863321236636595622_wp + q(7,7) = 0.111375967229143365899_wp + q(8,7) = 0.7149322477536284813995_wp + q(9,7) = -0.1444768161656941519630_wp + q(10,7) = 0.01622803190725754603783_wp + + end subroutine coeffs_1_6_5 + + subroutine coeffs_1_6_5_opt ( a, q ) + + CCTK_REAL, dimension(3), intent(OUT) :: a + CCTK_REAL, dimension(10,7), intent(OUT) :: q + + a(1) = 3.0_wp/4.0_wp + a(2) = -3.0_wp/20.0_wp + a(3) = 1.0_wp/60.0_wp + + q(1,1) = -2.465354921110524023660777656111276003457_wp + q(2,1) = 6.092129526663144141964665936667656020742_wp + q(3,1) = -7.730323816657860354911664841669140051855_wp + q(4,1) = 6.973765088877147139882219788892186735807_wp + q(5,1) = -3.980323816657860354911664841669140051855_wp + q(6,1) = 1.292129526663144141964665936667656020742_wp + q(7,1) = -0.1820215877771906903274443227779426701237_wp + q(8,1) = zero + q(9,1) = zero + q(10,1) = zero + + q(1,2) = -0.2234725650784319828746535134412736890421_wp + q(2,2) = -0.9329308121107134563129925525068570679651_wp + q(3,2) = 1.586820596545839371759081303802027231274_wp + q(4,2) = -0.3647002340377160216914505558624668821400_wp + q(5,2) = -0.2666957784872806143914117440166232718819_wp + q(6,2) = 0.3112949048634705032101261273629794071371_wp + q(7,2) = -0.1404504214762266650000768489896480092493_wp + q(8,2) = 0.03488568514730479833596013512958238764128_wp + q(9,2) = -0.004964021886392518344179263072091597647654_wp + q(10,2) = 0.0002126465201465853095969115943714918742904_wp + + q(1,3) = 0.1582216737061633151406179477554921935333_wp + q(2,3) = -1.137049298003377811733609086574457439398_wp + q(3,3) = 1.212364522932578587741649981040340946798_wp + q(4,3) = -0.9562288729513894906148167047868730813830_wp + q(5,3) = 1.066548057336766350478498057851678826640_wp + q(6,3) = -0.3478788551267041838265477441805600110467_wp + q(7,3) = -0.03133923293520187620333693909408071632123_wp + q(8,3) = 0.04098845955755862691072597869183962277781_wp + q(9,3) = -0.005963188634687155197078928402509551508436_wp + q(10,3) = 0.0003367341182936373038974376991292099082999_wp + + q(1,4) = 0.02915734641890708196910927068736798144670_wp + q(2,4) = -0.1169665089768926152768236581512624861308_wp + q(3,4) = -0.1112219092451476301503253995474190870412_wp + q(4,4) = -0.7924486261248032107393766820001361351677_wp + q(5,4) = 1.266650704820613624987450232358951199911_wp + q(6,4) = -0.2899273290506621673153239836530375587273_wp + q(7,4) = 0.002515684257201926199329020583484434062150_wp + q(8,4) = 0.01329713961871764653006682056620518602804_wp + q(9,4) = -0.001124464399630667352932212208930962568134_wp + q(10,4) = 0.00006796268169601114882659136477742818715059_wp + + q(1,5) = -0.04582150000326981674750984653096293434777_wp + q(2,5) = 0.2240986548857151482718685516611524323427_wp + q(3,5) = -0.3246718493011818141660859125588209338018_wp + q(4,5) = -0.3929792921782506986152017485694441380503_wp + q(5,5) = 0.1166355818729375628072830916953646214341_wp + q(6,5) = 0.3449626905957060254933930895775644438105_wp + q(7,5) = 0.1430419813354607083034935179267283951745_wp + q(8,5) = -0.07764802499372607792980458731991885121073_wp + q(9,5) = 0.01332439335504217034559288889042994978834_wp + q(10,5) = -0.0009426355684332077630290447720929851395193_wp + + q(1,6) = 0.003172814452954821196677290327889903944225_wp + q(2,6) = 0.00001061446045061551877105554145609103530766_wp + q(3,6) = -0.08747763580209736614983637747947172321794_wp + q(4,6) = 0.3975827322299876034907453299884380895682_wp + q(5,6) = -1.148835072393422871630425744497391344782_wp + q(6,6) = 0.3583006649535242306065761818925080902380_wp + q(7,6) = 0.5647665154270147564019144982190032455071_wp + q(8,6) = -0.09698196887272109736153117076061707705561_wp + q(9,6) = 0.008843905091972988427261446924164441884143_wp + q(10,6) = 0.0006174304523363194998474898440202828786385_wp + + q(1,7) = -0.008639107540858839028043929986084287776394_wp + q(2,7) = 0.04722773954485212324714352753530343274219_wp + q(3,7) = -0.1008747537650261142294540111407681552350_wp + q(4,7) = 0.08043834953845218736895768965086958762389_wp + q(5,7) = 0.1295138674713300902982857323205417604553_wp + q(6,7) = -0.7909424166489541737614153656634872155367_wp + q(7,7) = 0.03807866847647628589685997987877954466259_wp + q(8,7) = 0.7367055699548196242687865288427927434250_wp + q(9,7) = -0.1480235854665196220062411065981933720158_wp + q(10,7) = 0.01651566843542843794512095516024596165494_wp + + end subroutine coeffs_1_6_5_opt + +end module All_Coeffs_mod diff --git a/src/Coefficients2_2_1.F90 b/src/Coefficients2_2_1.F90 new file mode 100644 index 0000000..686df7b --- /dev/null +++ b/src/Coefficients2_2_1.F90 @@ -0,0 +1,61 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine set_coeff2_2_1 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(2), save :: a + CCTK_REAL, dimension(3,2), save :: q + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( first ) then + call coeffs_2_2_1 ( a, q ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dd(1,1) = q(1,1); dd(2,1) = q(2,1); dd(3,1) = q(3,1) + imin(1) = 1; imax(1) = 3 + dd(1,2) = q(1,2); dd(2,2) = q(2,2); dd(3,2) = q(3,2) + imin(2) = 1; imax(2) = 3 + il = 3 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + dd(nsize-2,nsize-1) = q(3,2); dd(nsize-1,nsize-1) = q(2,2) + dd(nsize,nsize-1) = q(1,2) + imin(nsize-1) = nsize-2; imax(nsize-1) = nsize + dd(nsize-2,nsize) = q(3,1); dd(nsize-1,nsize) = q(2,1) + dd(nsize,nsize) = q(1,1) + imin(nsize) = nsize-2; imax(nsize) = nsize + ir = nsize - 2 + end if + do i = il, ir + dd(i-1,i) = a(2); dd(i:i+1,i) = a(1:2) + imin(i) = i-1; imax(i) = i+1 + end do + +end subroutine set_coeff2_2_1 diff --git a/src/Coefficients2_4_2.F90 b/src/Coefficients2_4_2.F90 new file mode 100644 index 0000000..14a1cec --- /dev/null +++ b/src/Coefficients2_4_2.F90 @@ -0,0 +1,74 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine set_coeff2_4_2 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(3), save :: a + CCTK_REAL, dimension(6,4), save :: q + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( first ) then + call coeffs_2_4_2 ( a, q ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dd(1:6,1) = q(1:6,1) + imin(1) = 1; imax(1) = 6 + + dd(1:6,2) = q(1:6,2) + imin(2) = 1; imax(2) = 6 + + dd(1:6,3) = q(1:6,3) + imin(3) = 1; imax(3) = 6 + + dd(1:6,4) = q(1:6,4) + imin(4) = 1; imax(4) = 6 + + il = 5 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + dd(nsize-5:nsize,nsize-3) = q(6:1:-1,4) + imin(nsize-3) = nsize-5; imax(nsize-3) = nsize + + dd(nsize-5:nsize,nsize-2) = q(6:1:-1,3) + imin(nsize-2) = nsize-5; imax(nsize-2) = nsize + + dd(nsize-5:nsize,nsize-1) = q(6:1:-1,2) + imin(nsize-1) = nsize-5; imax(nsize-1) = nsize + + dd(nsize-5:nsize,nsize) = q(6:1:-1,1) + imin(nsize) = nsize-5; imax(nsize) = nsize + + ir = nsize - 4 + end if + do i = il, ir + dd(i-2:i-1,i) = a(3:2:-1); dd(i:i+2,i) = a(1:3) + imin(i) = i-2; imax(i) = i+2 + end do +end subroutine set_coeff2_4_2 diff --git a/src/Coefficients_2_1.F90 b/src/Coefficients_2_1.F90 index f8fe61e..35b261b 100644 --- a/src/Coefficients_2_1.F90 +++ b/src/Coefficients_2_1.F90 @@ -4,13 +4,13 @@ subroutine set_coeff_2_1 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: nsize, loc_order CCTK_INT, dimension(2), intent(IN) :: bb CCTK_INT, intent(IN) :: gsize @@ -25,16 +25,13 @@ subroutine set_coeff_2_1 ( nsize, loc_order, bb, gsize, imin, imax, dd ) logical, save :: first = .true. if ( first ) then - a(1) = 1.0_wp/2.0_wp - - q(1,1) = -1.0_wp; q(2,1) = 1.0_wp; q(3,1) = zero - q(1,2) = -1.0_wp/2.0_wp; q(2,2) = zero; q(3,2) = 1.0_wp/2.0_wp + call coeffs_1_2_1 ( a, q ) first = .false. end if dd = zero imin = 0 - imax = -1 + imax = 0 if ( bb(1) == 0 ) then il = 1 + gsize @@ -60,3 +57,81 @@ subroutine set_coeff_2_1 ( nsize, loc_order, bb, gsize, imin, imax, dd ) end do end subroutine set_coeff_2_1 + +subroutine set_coeff_up_2_1 ( nsize, dir, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, dir, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(-1:1), save :: a1, a2 + CCTK_REAL, dimension(3,2), save :: q1, q2 + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( .not. ( dir == -1 .or. dir == 1 ) ) then + call CCTK_WARN(0, 'Internal error: set_coeff_up_2_1 called with invalid dir value') + end if + + if ( first ) then + call coeffs_up_2_1 ( a1, q1, a2, q2 ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + if ( dir == -1 ) then + dd(1,1) = q1(1,1); dd(2,1) = q1(2,1) + imin(1) = 1; imax(1) = 2 + dd(1,2) = q1(1,2); dd(2,2) = q1(2,2) + imin(2) = 1; imax(2) = 2 + else + dd(1,1) = q2(1,1); dd(2,1) = q2(2,1) + imin(1) = 1; imax(1) = 2 + dd(2,2) = q2(2,2); dd(3,2) = q2(3,2) + imin(2) = 2; imax(2) = 3 + end if + il = 3 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + if ( dir == -1 ) then + dd(nsize-2,nsize-1) = -q2(3,2); dd(nsize-1,nsize-1) = -q2(2,2) + imin(nsize-1) = nsize-2; imax(nsize-1) = nsize-1 + dd(nsize-1,nsize) = -q2(2,1); dd(nsize,nsize) = -q2(1,1) + imin(nsize) = nsize-1; imax(nsize) = nsize + else + dd(nsize-1,nsize-1) = -q1(2,2); dd(nsize,nsize-1) = -q1(1,2) + imin(nsize-1) = nsize-1; imax(nsize-1) = nsize + dd(nsize-1,nsize) = -q1(2,1); dd(nsize,nsize) = -q1(1,1) + imin(nsize) = nsize-1; imax(nsize) = nsize + end if + ir = nsize - 2 + end if + do i = il, ir + if ( dir == -1 ) then + dd(i-1:i,i) = a1(-1:0) + imin(i) = i-1; imax(i) = i + else + dd(i:i+1,i) = a2(0:1) + imin(i) = i; imax(i) = i+1 + end if + end do +end subroutine set_coeff_up_2_1 diff --git a/src/Coefficients_4_2.F90 b/src/Coefficients_4_2.F90 index 778da65..0d0c49a 100644 --- a/src/Coefficients_4_2.F90 +++ b/src/Coefficients_4_2.F90 @@ -4,13 +4,13 @@ subroutine set_coeff_4_2 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: nsize, loc_order CCTK_INT, dimension(2), intent(IN) :: bb CCTK_INT, intent(IN) :: gsize @@ -25,26 +25,13 @@ subroutine set_coeff_4_2 ( nsize, loc_order, bb, gsize, imin, imax, dd ) logical, save :: first = .true. if ( first ) then - a(1) = 2.0_wp/3.0_wp; a(2) = -1.0_wp/12.0_wp - - q(1,1) = -24.0_wp/17.0_wp; q(2,1) = 59.0_wp/34.0_wp - q(3,1) = -4.0_wp/17.0_wp; q(4,1) = -3.0_wp/34.0_wp - q(5,1) = zero; q(6,1) = zero - q(1,2) = -1.0_wp/2.0_wp; q(2,2) = zero - q(3,2) = 1.0_wp/2.0_wp; q(4,2) = zero - q(5,2) = zero; q(6,2) = zero - q(1,3) = 4.0_wp/43.0_wp; q(2,3) = -59.0_wp/86.0_wp - q(3,3) = zero; q(4,3) = 59.0_wp/86.0_wp - q(5,3) = -4.0_wp/43.0_wp; q(6,3) = zero - q(1,4) = 3.0_wp/98.0_wp; q(2,4) = zero - q(3,4) = -59.0_wp/98.0_wp; q(4,4) = zero - q(5,4) = 32.0_wp/49.0_wp; q(6,4) = -4.0_wp/49.0_wp + call coeffs_1_4_2 ( a, q ) first = .false. end if dd = zero imin = 0 - imax = -1 + imax = 0 if ( bb(1) == 0 ) then il = 1 + gsize @@ -84,3 +71,109 @@ subroutine set_coeff_4_2 ( nsize, loc_order, bb, gsize, imin, imax, dd ) imin(i) = i-2; imax(i) = i+2 end do end subroutine set_coeff_4_2 + +subroutine set_coeff_up_4_2 ( nsize, dir, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, dir, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(-2:2), save :: a1, a2 + CCTK_REAL, dimension(6,4), save :: q1, q2 + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( .not. ( dir == -1 .or. dir == 1 ) ) then + call CCTK_WARN(0, 'Internal error: set_coeff_up_4_2 called with invalid dir value') + end if + + if ( first ) then + call coeffs_up_4_2 ( a1, q1, a2, q2 ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + if ( dir == -1 ) then + dd(1:4,1) = q1(1:4,1) + imin(1) = 1; imax(1) = 4 + + dd(1:4,2) = q1(1:4,2) + imin(2) = 1; imax(2) = 4 + + dd(1:4,3) = q1(1:4,3) + imin(3) = 1; imax(3) = 4 + + dd(1:5,4) = q1(1:5,4) + imin(4) = 1; imax(4) = 5 + else + dd(1:4,1) = q2(1:4,1) + imin(1) = 1; imax(1) = 4 + + dd(1:4,2) = q2(1:4,2) + imin(2) = 1; imax(2) = 4 + + dd(2:5,3) = q2(2:5,3) + imin(3) = 2; imax(3) = 5 + + dd(1:6,4) = q2(1:6,4) + imin(4) = 1; imax(4) = 6 + end if + il = 5 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + if ( dir == -1 ) then + dd(nsize-5:nsize,nsize-3) = -q2(6:1:-1,4) + imin(nsize-3) = nsize-5; imax(nsize-3) = nsize + + dd(nsize-4:nsize-1,nsize-2) = -q2(5:2:-1,3) + imin(nsize-2) = nsize-4; imax(nsize-2) = nsize-1 + + dd(nsize-3:nsize,nsize-1) = -q2(4:1:-1,2) + imin(nsize-1) = nsize-3; imax(nsize-1) = nsize + + dd(nsize-3:nsize,nsize) = -q2(4:1:-1,1) + imin(nsize) = nsize-3; imax(nsize) = nsize + else + dd(nsize-4:nsize,nsize-3) = -q1(5:1:-1,4) + imin(nsize-3) = nsize-4; imax(nsize-3) = nsize + + dd(nsize-3:nsize,nsize-2) = -q1(4:1:-1,3) + imin(nsize-2) = nsize-3; imax(nsize-2) = nsize + + dd(nsize-3:nsize,nsize-1) = -q1(4:1:-1,2) + imin(nsize-1) = nsize-3; imax(nsize-1) = nsize + + dd(nsize-3:nsize,nsize) = -q1(4:1:-1,1) + imin(nsize) = nsize-3; imax(nsize) = nsize + end if + ir = nsize - 4 + end if + do i = il, ir + if ( dir == -1 ) then + dd(i-2:i+1,i) = a1(-2:1) + imin(i) = i-2; imax(i) = i+1 + else + dd(i-1:i+2,i) = a2(-1:2) + imin(i) = i-1; imax(i) = i+2 + end if + end do +end subroutine set_coeff_up_4_2 diff --git a/src/Coefficients_4_3.F90 b/src/Coefficients_4_3.F90 index 89c824d..4b1c85a 100644 --- a/src/Coefficients_4_3.F90 +++ b/src/Coefficients_4_3.F90 @@ -4,13 +4,13 @@ subroutine set_coeff_4_3 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: nsize, loc_order CCTK_INT, dimension(2), intent(IN) :: bb CCTK_INT, intent(IN) :: gsize @@ -19,66 +19,13 @@ subroutine set_coeff_4_3 ( nsize, loc_order, bb, gsize, imin, imax, dd ) CCTK_REAL, dimension(2), save :: a CCTK_REAL, dimension(7,5), save :: q - CCTK_REAL :: f0, f1, f2, f3 CCTK_INT :: i, il, ir logical, save :: first = .true. if ( first ) then - a(1) = 2.0_wp/3.0_wp; a(2) = -1.0_wp/12.0_wp - - f0 = sqrt(26116897.0_wp) - f1 = -56764003702447356523.0_wp + 8154993476273221.0_wp * f0 - f2 = -55804550303.0_wp + 9650225.0_wp * f0 - f3 = 3262210757.0_wp + 271861.0_wp * f0 - - q(1,1) = -11._wp/6.0_wp; q(2,1) = 3.0_wp - q(3,1) = -3.0_wp/2.0_wp; q(4,1) = 1.0_wp/3.0_wp - q(5,1) = zero; q(6,1) = zero; q(7,1) = zero - - q(1,2) = -24.0_wp * ( -779042810827742869.0_wp + & - 104535124033147.0_wp * f0 ) / f1 - q(2,2) = -( -176530817412806109689.0_wp + & - 29768274816875927.0_wp * f0 ) / ( 6.0_wp * f1 ) - q(3,2) = 343.0_wp * ( -171079116122226871.0_wp + & - 27975630462649.0_wp * f0 ) / f1 - q(4,2) = -3.0_wp * ( -7475554291248533227.0_wp + & - 1648464218793925.0_wp * f0 ) / ( 2.0_wp * f1 ) - q(5,2) = ( -2383792768180030915.0_wp + & - 1179620587812973.0_wp * f0 ) / ( 3.0_wp * f1 ) - q(6,2) = -1232.0_wp * ( -115724529581315.0_wp + 37280576429.0_wp * f0 ) / f1 - q(7,2) = zero - - q(1,3) = -12.0_wp * ( -380966843.0_wp + 86315.0_wp * f0 ) / f2 - q(2,3) = ( 5024933015.0_wp + 2010631.0_wp * f0 ) / ( 3.0_wp * f2 ) - q(3,3) = -231.0_wp * ( -431968921.0_wp + 86711.0_wp * f0 ) / ( 2.0_wp * f2 ) - q(4,3) = ( -65931742559.0_wp + 12256337.0_wp * f0 ) / f2 - q(5,3) = -( -50597298167.0_wp + 9716873.0_wp * f0 ) / ( 6.0_wp * f2 ) - q(6,3) = -88.0_wp * ( -15453061.0_wp + 2911.0_wp * f0 ) / f2 - q(7,3) = zero - - q(1,4) = 48.0_wp * ( -56020909845192541.0_wp + & - 9790180507043.0_wp * f0 ) / f1 - q(2,4) = ( -9918249049237586011.0_wp + & - 1463702013196501.0_wp * f0 ) / ( 6.0_wp * f1) - q(3,4) = -13.0_wp * ( -4130451756851441723.0_wp + & - 664278707201077.0_wp * f0 ) / f1 - q(4,4) = 3.0_wp * ( -26937108467782666617.0_wp + & - 5169063172799767.0_wp * f0 ) / ( 2.0_wp * f1 ) - q(5,4) = -( 6548308508012371315.0_wp + & - 3968886380989379.0_wp * f0 ) / ( 3.0_wp * f1 ) - q(6,4) = 88.0_wp * ( -91337851897923397.0_wp + & - 19696768305507.0_wp * f0 ) / f1 - q(7,4) = 242.0_wp * ( -120683.0_wp + 15.0_wp * f0 ) / f3 - - q(1,5) = 264.0_wp * ( -120683.0_wp + 15.0_wp * f0 ) / f3 - q(2,5) = ( -43118111.0_wp + 23357.0_wp * f0 ) / ( 3.0_wp * f3 ) - q(3,5) = -47.0_wp * ( -28770085.0_wp + 2259.0_wp * f0 ) / ( 2.0_wp * f3 ) - q(4,5) = -3.0_wp * ( 1003619433.0_wp + 11777.0_wp * f0 ) / f3 - q(5,5) = -11.0_wp * ( -384168269.0_wp + 65747.0_wp * f0 ) / ( 6.0_wp * f3 ) - q(6,5) = 22.0_wp * ( 87290207.0_wp + 10221.0_wp * f0 ) / f3 - q(7,5) = -66.0_wp * ( 3692405.0_wp + 419.0_wp * f0 ) / f3 + call coeffs_1_4_3 ( a, q ) first = .false. end if diff --git a/src/Coefficients_4_3_min_err_coeff.F90 b/src/Coefficients_4_3_min_err_coeff.F90 new file mode 100644 index 0000000..1b5e728 --- /dev/null +++ b/src/Coefficients_4_3_min_err_coeff.F90 @@ -0,0 +1,80 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine set_coeff_4_3_opt ( nsize, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(2), save :: a + CCTK_REAL, dimension(7,5), save :: q + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( first ) then + call coeffs_1_4_3_opt ( a, q ) + first = .false. + end if + + dd = zero + imin = 0 + imax = -1 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dd(1:5,1) = q(1:5,1) + imin(1) = 1; imax(1) = 5 + + dd(1:7,2) = q(1:7,2) + imin(2) = 1; imax(2) = 7 + + dd(1:7,3) = q(1:7,3) + imin(3) = 1; imax(3) = 7 + + dd(1:7,4) = q(1:7,4) + imin(4) = 1; imax(4) = 7 + + dd(1:7,5) = q(1:7,5) + imin(5) = 1; imax(5) = 7 + + il = 6 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + dd(nsize-6:nsize,nsize-4) = -q(7:1:-1,5) + imin(nsize-4) = nsize-6; imax(nsize-4) = nsize + + dd(nsize-6:nsize,nsize-3) = -q(7:1:-1,4) + imin(nsize-3) = nsize-6; imax(nsize-3) = nsize + + dd(nsize-6:nsize,nsize-2) = -q(7:1:-1,3) + imin(nsize-2) = nsize-6; imax(nsize-2) = nsize + + dd(nsize-6:nsize,nsize-1) = -q(7:1:-1,2) + imin(nsize-1) = nsize-6; imax(nsize-1) = nsize + + dd(nsize-4:nsize,nsize) = -q(5:1:-1,1) + imin(nsize) = nsize-4; imax(nsize) = nsize + + ir = nsize - 5 + end if + do i = il, ir + dd(i-2:i-1,i) = -a(2:1:-1); dd(i+1:i+2,i) = a(1:2) + imin(i) = i-2; imax(i) = i+2 + end do +end subroutine set_coeff_4_3_opt diff --git a/src/Coefficients_6_3.F90 b/src/Coefficients_6_3.F90 index 958d170..498723a 100644 --- a/src/Coefficients_6_3.F90 +++ b/src/Coefficients_6_3.F90 @@ -4,13 +4,13 @@ subroutine set_coeff_6_3 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: nsize, loc_order CCTK_INT, dimension(2), intent(IN) :: bb CCTK_INT, intent(IN) :: gsize @@ -25,39 +25,13 @@ subroutine set_coeff_6_3 ( nsize, loc_order, bb, gsize, imin, imax, dd ) logical, save :: first = .true. if ( first ) then - a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp - - q(1,1) = -21600.0_wp/13649.0_wp; q(2,1) = 81763.0_wp/40947.0_wp - q(3,1) = 131.0_wp/27298.0_wp; q(4,1) = -9143.0_wp/13649.0_wp - q(5,1) = 20539.0_wp/81894.0_wp; q(6,1) = zero; - q(7,1) = zero; q(8,1) = zero; q(9,1) = zero - q(1,2) = -81763.0_wp/180195.0_wp; q(2,2) = zero - q(3,2) = 7357.0_wp/36039.0_wp; q(4,2) = 30637.0_wp/72078.0_wp - q(5,2) = -2328.0_wp/12013.0_wp; q(6,2) = 6611.0_wp/360390.0_wp - q(7,2) = zero; q(8,2) = zero; q(9,2) = zero - q(1,3) = -131.0_wp/54220.0_wp; q(2,3) = -7357.0_wp/16266.0_wp - q(3,3) = zero; q(4,3) = 645.0_wp/2711.0_wp - q(5,3) = 11237.0_wp/32532.0_wp; q(6,3) = -3487.0_wp/27110.0_wp - q(7,3) = zero; q(8,3) = zero; q(9,3) = zero - q(1,4) = 9143.0_wp/53590.0_wp; q(2,4) = -30637.0_wp/64308.0_wp - q(3,4) = -645.0_wp/5359.0_wp; q(4,4) = zero - q(5,4) = 13733.0_wp/32154.0_wp; q(6,4) = -67.0_wp/4660.0_wp - q(7,4) = 72.0_wp/5359.0_wp; q(8,4) = zero; q(9,4) = zero; - q(1,5) = -20539.0_wp/236310.0_wp; q(2,5) = 2328.0_wp/7877.0_wp - q(3,5) = -11237.0_wp/47262.0_wp; q(4,5) = -13733.0_wp/23631.0_wp - q(5,5) = zero; q(6,5) = 89387.0_wp/118155.0_wp - q(7,5) = -1296.0_wp/7877.0_wp; q(8,5) = 144.0_wp/7877.0_wp; q(9,5) = zero - q(1,6) = zero; q(2,6) = -6611.0_wp/262806.0_wp - q(3,6) = 3487.0_wp/43801.0_wp; q(4,6) = 1541.0_wp/87602.0_wp - q(5,6) = -89387.0_wp/131403.0_wp; q(6,6) = zero - q(7,6) = 32400.0_wp/43801.0_wp; q(8,6) = -6480.0_wp/43801.0_wp - q(9,6) = 720.0_wp/43801.0_wp + call coeffs_1_6_3 ( a, q ) first = .false. end if dd = zero imin = 0 - imax = -1 + imax = 0 if ( bb(1) == 0 ) then il = 1 + gsize diff --git a/src/Coefficients_6_3_min_err_coeff.F90 b/src/Coefficients_6_3_min_err_coeff.F90 new file mode 100644 index 0000000..ffad15f --- /dev/null +++ b/src/Coefficients_6_3_min_err_coeff.F90 @@ -0,0 +1,217 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine set_coeff_6_3_opt ( nsize, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(3), save :: a + CCTK_REAL, dimension(9,6), save :: q + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( first ) then + call coeffs_1_6_3_opt ( a, q ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dd(1:6,1) = q(1:6,1) + imin(1) = 1; imax(1) = 6 + + dd(1:6,2) = q(1:6,2) + imin(2) = 1; imax(2) = 6 + + dd(1:6,3) = q(1:6,3) + imin(3) = 1; imax(3) = 6 + + dd(1:7,4) = q(1:7,4) + imin(4) = 1; imax(4) = 7 + + dd(1:8,5) = q(1:8,5) + imin(5) = 1; imax(5) = 8 + + dd(1:9,6) = q(1:9,6) + imin(6) = 1; imax(6) = 9 + + il = 7 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + dd(nsize-8:nsize,nsize-5) = -q(9:1:-1,6) + imin(nsize-5) = nsize-8; imax(nsize-5) = nsize + + dd(nsize-7:nsize,nsize-4) = -q(8:1:-1,5) + imin(nsize-4) = nsize-7; imax(nsize-4) = nsize + + dd(nsize-6:nsize,nsize-3) = -q(7:1:-1,4) + imin(nsize-3) = nsize-6; imax(nsize-3) = nsize + + dd(nsize-5:nsize,nsize-2) = -q(6:1:-1,3) + imin(nsize-2) = nsize-5; imax(nsize-2) = nsize + + dd(nsize-5:nsize,nsize-1) = -q(6:1:-1,2) + imin(nsize-1) = nsize-5; imax(nsize-1) = nsize + + dd(nsize-5:nsize,nsize) = -q(6:1:-1,1) + imin(nsize) = nsize-5; imax(nsize) = nsize + + ir = nsize - 6 + end if + do i = il, ir + dd(i-3:i-1,i) = -a(3:1:-1); dd(i+1:i+3,i) = a(1:3) + imin(i) = i-3; imax(i) = i+3 + end do +end subroutine set_coeff_6_3_opt + +subroutine set_coeff_up_6_3_opt ( nsize, dir, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, dir, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(-3:3), save :: a1, a2 + CCTK_REAL, dimension(9,6), save :: q1, q2 + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( .not. ( dir == -1 .or. dir == 1 ) ) then + call CCTK_WARN(0, 'Internal error: set_coeff_up_6_3 called with invalid dir value') + end if + + if ( first ) then + call coeffs_up_6_3_opt ( a1, q1, a2, q2 ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + if ( dir == -1 ) then + dd(1:6,1) = q1(1:6,1) + imin(1) = 1; imax(1) = 6 + + dd(1:6,2) = q1(1:6,2) + imin(2) = 1; imax(2) = 6 + + dd(1:6,3) = q1(1:6,3) + imin(3) = 1; imax(3) = 6 + + dd(1:6,4) = q1(1:6,4) + imin(4) = 1; imax(4) = 6 + + dd(1:7,5) = q1(1:7,5) + imin(5) = 1; imax(5) = 7 + + dd(1:8,6) = q1(1:8,6) + imin(6) = 1; imax(6) = 8 + else + dd(1:6,1) = q2(1:6,1) + imin(1) = 1; imax(1) = 6 + + dd(1:6,2) = q2(1:6,2) + imin(2) = 1; imax(2) = 6 + + dd(1:6,3) = q2(1:6,3) + imin(3) = 1; imax(3) = 6 + + dd(1:7,4) = q2(1:7,4) + imin(4) = 1; imax(4) = 7 + + dd(1:8,5) = q2(1:8,5) + imin(5) = 1; imax(5) = 8 + + dd(1:9,6) = q2(1:9,6) + imin(6) = 1; imax(6) = 9 + end if + il = 7 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + if ( dir == -1 ) then + dd(nsize-8:nsize,nsize-5) = -q2(9:1:-1,6) + imin(nsize-5) = nsize-8; imax(nsize-5) = nsize + + dd(nsize-7:nsize,nsize-4) = -q2(8:1:-1,5) + imin(nsize-4) = nsize-7; imax(nsize-4) = nsize + + dd(nsize-6:nsize,nsize-3) = -q2(7:1:-1,4) + imin(nsize-3) = nsize-6; imax(nsize-3) = nsize + + dd(nsize-5:nsize,nsize-2) = -q2(6:1:-1,3) + imin(nsize-2) = nsize-5; imax(nsize-2) = nsize + + dd(nsize-5:nsize,nsize-1) = -q2(6:1:-1,2) + imin(nsize-1) = nsize-5; imax(nsize-1) = nsize + + dd(nsize-5:nsize,nsize) = -q2(6:1:-1,1) + imin(nsize) = nsize-5; imax(nsize) = nsize + else + dd(nsize-7:nsize,nsize-5) = -q1(8:1:-1,6) + imin(nsize-5) = nsize-7; imax(nsize-5) = nsize + + dd(nsize-6:nsize,nsize-4) = -q1(7:1:-1,5) + imin(nsize-4) = nsize-6; imax(nsize-4) = nsize + + dd(nsize-5:nsize,nsize-3) = -q1(6:1:-1,4) + imin(nsize-3) = nsize-5; imax(nsize-3) = nsize + + dd(nsize-5:nsize,nsize-2) = -q1(6:1:-1,3) + imin(nsize-2) = nsize-5; imax(nsize-2) = nsize + + dd(nsize-5:nsize,nsize-1) = -q1(6:1:-1,2) + imin(nsize-1) = nsize-5; imax(nsize-1) = nsize + + dd(nsize-5:nsize,nsize) = -q1(6:1:-1,1) + imin(nsize) = nsize-5; imax(nsize) = nsize + end if + ir = nsize - 6 + end if + + do i = il, ir + if ( dir == -1 ) then + dd(i-3:i+2,i) = a1(-3:2) + imin(i) = i-3; imax(i) = i+2 + else + dd(i-2:i+3,i) = a2(-2:3) + imin(i) = i-2; imax(i) = i+3 + end if + end do +end subroutine set_coeff_up_6_3_opt diff --git a/src/Coefficients_6_5.F90 b/src/Coefficients_6_5.F90 index 361ab5b..22677f7 100644 --- a/src/Coefficients_6_5.F90 +++ b/src/Coefficients_6_5.F90 @@ -4,13 +4,13 @@ subroutine set_coeff_6_5 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: nsize, loc_order CCTK_INT, dimension(2), intent(IN) :: bb CCTK_INT, intent(IN) :: gsize @@ -25,77 +25,7 @@ subroutine set_coeff_6_5 ( nsize, loc_order, bb, gsize, imin, imax, dd ) logical, save :: first = .true. if ( first ) then - a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp - - q(1,1) = -137.0_wp/60.0_wp; q(2,1) = 5.0_wp; q(3,1) = -5.0_wp; - q(4,1) = 10.0_wp/3.0_wp; q(5,1) = -5.0_wp/4.0_wp; q(6,1) = 1.0_wp/5.0_wp; - q(7,1) = zero; q(8,1) = zero; q(9,1) = zero; q(10,1) = zero; - - q(1,2) = -0.3209098489859668118347_wp - q(2,2) = -0.359441670715467075894_wp - q(3,2) = 0.195756852998105503889_wp - q(4,2) = 1.394685510250317033169_wp - q(5,2) = -1.448965775497476572821_wp - q(6,2) = 0.6519476244467816674835_wp - q(7,2) = -0.1115052611983591304249_wp - q(8,2) = -0.00156743129793461356831_wp - q(9,2) = zero; q(10,2) = zero - - q(1,3) = 0.0980796259621024870281_wp - q(2,3) = -0.784752101846956387607_wp - q(3,3) = 0.364206221878666751300_wp - q(4,3) = 0.102097753636344358379_wp - q(5,3) = 0.377167650934576412896_wp - q(6,3) = -0.173241400242683302020_wp - q(7,3) = 0.0062120424243610783650_wp - q(8,3) = 0.01153111791917461507898_wp - q(9,3) = -0.00130091066558601341956_wp - q(10,3) = zero - - q(1,4) = 0.0771947815148234674634_wp - q(2,4) = -0.4124719432622107102831_wp - q(3,4) = 0.654798717867622763906_wp - q(4,4) = -1.873474657556531216053_wp - q(5,4) = 2.161961221935152129759_wp - q(6,4) = -0.729147814207596325277_wp - q(7,4) = 0.1292509053479867634674_wp - q(8,4) = -0.01092898521375837831427_wp - q(9,4) = 0.00316983426828354261009_wp - q(10,4) = -0.000352060693772037278516_wp - - q(1,5) = -0.01135836398682271847110_wp - q(2,5) = 0.0114974985688122284189_wp - q(3,5) = 0.228765565489867047381_wp - q(4,5) = -1.179122428698534075609_wp - q(5,5) = 0.774618306056840861215_wp - q(6,5) = 0.016612403904600041087_wp - q(7,5) = 0.2399304273448163041220_wp - q(8,5) = -0.0959180672407791626759_wp - q(9,5) = 0.01612460763754670343830_wp - q(10,5) = -0.001149949076347228906108_wp - - q(1,6) = -0.01912046962023373131259_wp - q(2,6) = 0.1569245474161812198493_wp - q(3,6) = -0.567250839387340928718_wp - q(4,6) = 1.230411310316952671353_wp - q(5,6) = -2.048795717924254691221_wp - q(6,6) = 0.982715833107347313532_wp - q(7,6) = 0.2876584784911885215053_wp - q(8,6) = -0.0207657038198929292487_wp - q(9,6) = -0.00335290957957120811713_wp - q(10,6) = 0.001575470999623762377395_wp - - q(1,7) = -0.0076072322555736921424_wp - q(2,7) = 0.034503414345314189270_wp - q(3,7) = -0.044377233426986476366_wp - q(4,7) = -0.049408595803628143797_wp - q(5,7) = 0.304693537653175477283_wp - q(6,7) = -0.935863321236636595622_wp - q(7,7) = 0.111375967229143365899_wp - q(8,7) = 0.7149322477536284813995_wp - q(9,7) = -0.1444768161656941519630_wp - q(10,7) = 0.01622803190725754603783_wp - + call coeffs_1_6_5 ( a, q ) first = .false. end if diff --git a/src/Coefficients_6_5_min_err_coeff.F90 b/src/Coefficients_6_5_min_err_coeff.F90 new file mode 100644 index 0000000..4ca0622 --- /dev/null +++ b/src/Coefficients_6_5_min_err_coeff.F90 @@ -0,0 +1,92 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine set_coeff_6_5_opt ( nsize, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(3), save :: a + CCTK_REAL, dimension(10,7), save :: q + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( first ) then + call coeffs_1_6_5_opt ( a, q ) + first = .false. + end if + + dd = zero + imin = 0 + imax = -1 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dd(1:7,1) = q(1:7,1) + imin(1) = 1; imax(1) = 7 + + dd(1:10,2) = q(1:10,2) + imin(2) = 1; imax(2) = 10 + + dd(1:10,3) = q(1:10,3) + imin(3) = 1; imax(3) = 10 + + dd(1:10,4) = q(1:10,4) + imin(4) = 1; imax(4) = 10 + + dd(1:10,5) = q(1:10,5) + imin(5) = 1; imax(5) = 10 + + dd(1:10,6) = q(1:10,6) + imin(6) = 1; imax(6) = 10 + + dd(1:10,7) = q(1:10,7) + imin(7) = 1; imax(7) = 10 + + il = 8 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + dd(nsize-9:nsize,nsize-6) = -q(10:1:-1,7) + imin(nsize-6) = nsize-9; imax(nsize-6) = nsize + + dd(nsize-9:nsize,nsize-5) = -q(10:1:-1,6) + imin(nsize-5) = nsize-9; imax(nsize-5) = nsize + + dd(nsize-9:nsize,nsize-4) = -q(10:1:-1,5) + imin(nsize-4) = nsize-9; imax(nsize-4) = nsize + + dd(nsize-9:nsize,nsize-3) = -q(10:1:-1,4) + imin(nsize-3) = nsize-9; imax(nsize-3) = nsize + + dd(nsize-9:nsize,nsize-2) = -q(10:1:-1,3) + imin(nsize-2) = nsize-9; imax(nsize-2) = nsize + + dd(nsize-9:nsize,nsize-1) = -q(10:1:-1,2) + imin(nsize-1) = nsize-9; imax(nsize-1) = nsize + + dd(nsize-6:nsize,nsize) = -q(7:1:-1,1) + imin(nsize) = nsize-6; imax(nsize) = nsize + + ir = nsize - 7 + end if + do i = il, ir + dd(i-3:i-1,i) = -a(3:1:-1); dd(i+1:i+3,i) = a(1:3) + imin(i) = i-3; imax(i) = i+3 + end do +end subroutine set_coeff_6_5_opt diff --git a/src/Coefficients_8_4.F90 b/src/Coefficients_8_4.F90 index eb029ba..d2461b5 100644 --- a/src/Coefficients_8_4.F90 +++ b/src/Coefficients_8_4.F90 @@ -4,13 +4,13 @@ subroutine set_coeff_8_4 ( nsize, loc_order, bb, gsize, imin, imax, dd ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: nsize, loc_order CCTK_INT, dimension(2), intent(IN) :: bb CCTK_INT, intent(IN) :: gsize @@ -19,152 +19,19 @@ subroutine set_coeff_8_4 ( nsize, loc_order, bb, gsize, imin, imax, dd ) CCTK_REAL, dimension(4), save :: a CCTK_REAL, dimension(12,8), save :: q - CCTK_REAL, parameter :: x1 = 0.541_wp, x2 = -0.0675_wp, x3 = 0.748_wp CCTK_INT :: i, il, ir logical, save :: first = .true. if ( first ) then - a(1) = 4.0_wp/5.0_wp; a(2) = -1.0_wp/5.0_wp - a(3) = 4.0_wp/105.0_wp; a(4) = -1.0_wp/280.0_wp - - q(1,1) = -2540160.0_wp/1498139.0_wp - q(2,1) = 9.0_wp * ( 2257920.0_wp*x1 + 11289600.0_wp*x2 + & - 22579200.0_wp*x3 - 15849163.0_wp ) / 5992556.0_wp - q(3,1) = 3.0_wp * ( -33868800.0_wp*x1 - 162570240.0_wp*x2 - & - 304819200.0_wp*x3 + 235236677.0_wp ) / 5992556.0_wp - q(4,1) = ( 609638400.0_wp*x1 + 2743372800.0_wp*x2 + & - 4572288000.0_wp * x3 - 3577778591.0_wp ) / 17977668.0_wp - q(5,1) = 3.0_wp * ( -16934400*x1 - 67737600.0_wp*x2 - & - 84672000.0_wp*x3 + 67906303.0_wp ) / 1498139.0_wp - q(6,1) = 105.0_wp * ( 967680.0_wp*x1 + 2903040.0_wp*x2 - & - 305821.0_wp ) / 5992556.0_wp - q(7,1) = 49.0_wp * ( -1244160.0_wp*x1 + 18662400.0_wp * x3 - & - 13322233.0_wp ) / 17977668.0_wp - q(8,1) = 3.0_wp * ( -6773760.0_wp*x2 - 33868800.0_wp*x3 + & - 24839327.0_wp ) / 5992556.0_wp - q(9,1) = zero; q(10,1) = zero; q(11,1) = zero; q(12,1) = zero - - q(1,2) = 9.0_wp * ( -2257920.0_wp*x1 - 11289600.0_wp*x2 - & - 22579200.0_wp*x3 + 15849163.0_wp ) / 31004596.0_wp - q(2,2) = zero - q(3,2) = 3.0_wp * ( 7257600.0_wp*x1 + 33868800.0_wp*x2 + & - 60963840.0_wp*x3 - 47167457.0_wp ) / 2214614.0_wp - q(4,2) = 3.0_wp * ( -9676800.0_wp*x1 - 42336000.0_wp*x2 - & - 67737600.0_wp*x3 + 53224573.0_wp ) / 1107307.0_wp - q(5,2) = 7.0_wp * ( 55987200.0_wp*x1 + 217728000.0_wp*x2 + & - 261273600.0_wp*x3 - 211102099.0_wp ) / 13287684.0_wp - q(6,2) = 3.0_wp * ( -11612160.0_wp*x1 - 33868800.0_wp*x2 + & - 3884117.0_wp ) / 2214614.0_wp - q(7,2) = 150.0_wp * ( 24192.0_wp*x1 - 338688.0_wp*x3 + & - 240463.0_wp ) / 1107307.0_wp - q(8,2) = ( 152409600.0_wp*x2 + 731566080.0_wp*x3 - & - 536324953.0_wp ) / 46506894.0_wp - q(9,2) = zero; q(10,2) = zero; q(11,2) = zero; q(12,2) = zero - - q(1,3) = ( 33868800.0_wp*x1 + 162570240.0_wp*x2 + & - 304819200.0_wp*x3 - 235236677.0_wp ) / 1743924.0_wp - q(2,3) = ( -7257600.0_wp*x1 - 33868800.0_wp*x2 - & - 60963840.0_wp*x3 + 47167457.0_wp ) / 124566.0_wp - q(3,3) = zero - q(4,3) = ( 24192000.0_wp*x1 + 101606400.0_wp*x2 + & - 152409600.0_wp*x3 - 120219461.0_wp ) / 124566.0_wp - q(5,3) = ( -72576000.0_wp*x1 - 270950400.0_wp*x2 - & - 304819200.0_wp*x3 + 249289259.0_wp ) / 249132.0_wp - q(6,3) = 9.0_wp * ( 806400.0_wp*x1 + 2257920.0_wp*x2 - & - 290167.0_wp ) / 41522.0_wp - q(7,3) = 6.0_wp * ( -134400.0_wp*x1 + 1693440.0_wp*x3 - & - 1191611.0_wp ) / 20761.0_wp - q(8,3) = 5.0_wp * ( -2257920.0_wp*x2 - 10160640.0_wp*x3 + & - 7439833.0_wp ) / 290654.0_wp - q(9,3) = zero; q(10,3) = zero; q(11,3) = zero; q(12,3) = zero - - q(1,4) = ( -609638400.0_wp*x1 - 2743372800.0_wp*x2 - & - 4572288000.0_wp*x3 + 3577778591.0_wp ) / 109619916.0_wp - q(2,4) = 3.0_wp * ( 9676800.0_wp*x1 + 42336000.0_wp*x2 + & - 67737600.0_wp*x3 - 53224573.0_wp ) / 1304999.0_wp - q(3,4) = 3.0_wp * ( -24192000.0_wp*x1 - 101606400.0_wp*x2 - & - 152409600.0_wp*x3 + 120219461.0_wp ) / 2609998.0_wp - q(4,4) = zero - q(5,4) = 9.0_wp * ( 16128000.0_wp*x1 + 56448000.0_wp*x2 + & - 56448000.0_wp*x3 - 47206049.0_wp ) / 5219996.0_wp - q(6,4) = 3.0_wp * ( -19353600.0_wp*x1 - 50803200.0_wp*x2 + & - 7628371.0_wp ) / 2609998.0_wp - q(7,4) = 2.0_wp * ( 10886400.0_wp*x1 - 114307200.0_wp*x3 + & - 79048289.0_wp ) / 3914997.0_wp - q(8,4) = 75.0_wp * ( 1354752.0_wp*x2 + 5419008.0_wp*x3 - & - 3952831.0_wp ) / 18269986.0_wp - q(9,4) = zero; q(10,4) = zero; q(11,4) = zero; q(12,4) = zero - - q(1,5) = 3.0_wp * ( 16934400.0_wp*x1 + 67737600.0_wp*x2 + & - 84672000.0_wp*x3 - 67906303.0_wp ) / 2096689.0_wp - q(2,5) = 7.0_wp * ( -55987200.0_wp*x1 - 217728000.0_wp*x2 - & - 261273600.0_wp*x3 + 211102099.0_wp ) / 3594324.0_wp - q(3,5) = 3.0_wp * ( 72576000.0_wp*x1 + 270950400.0_wp*x2 + & - 304819200.0_wp*x3 - 249289259.0_wp ) / 1198108.0_wp - q(4,5) = 9.0_wp * ( -16128000.0_wp*x1 - 56448000.0_wp*x2 - & - 56448000.0_wp*x3 + 47206049.0_wp ) / 1198108.0_wp - q(5,5) = zero - q(6,5) = 105.0_wp * ( 414720.0_wp*x1 + 967680.0_wp*x2 - & - 165527.0_wp ) / 1198108.0_wp - q(7,5) = 15.0_wp * ( -967680.0_wp*x1 + 6773760.0_wp*x3 - & - 4472029.0_wp ) / 1198108.0_wp - q(8,5) = ( -304819200.0_wp*x2 - 914457600.0_wp*x3 + & - 657798011.0_wp ) / 25160268.0_wp - q(9,5) = -2592.0_wp/299527.0_wp; - q(10,5) = zero; q(11,5) = zero; q(12,5) = zero - - q(1,6) = 5.0_wp * ( -967680.0_wp*x1 - 2903040.0_wp*x2 + & - 305821.0_wp ) / 1237164.0_wp - q(2,6) = ( 11612160.0_wp*x1 + 33868800.0_wp*x2 - & - 3884117.0_wp ) / 618582.0_wp - q(3,6) = 9.0_wp * ( -806400.0_wp*x1 - 2257920.0_wp*x2 + & - 290167.0_wp ) / 206194.0_wp - q(4,6) = ( 19353600.0_wp*x1 + 50803200.0_wp*x2 - & - 7628371.0_wp ) / 618582.0_wp - q(5,6) = 35.0_wp * ( -414720.0_wp*x1 - 967680.0_wp*x2 + & - 165527.0_wp ) / 1237164.0_wp - q(6,6) = zero; q(7,6) = 80640.0_wp*x1 / 103097.0_wp - q(8,6) = 80640.0_wp*x2 / 103097.0_wp; q(9,6) = 3072.0_wp / 103097.0_wp - q(10,6) = -288.0_wp/103097.0_wp; q(11,6) = zero; q(12,6) = zero - - q(1,7) = 7.0_wp * ( 1244160.0_wp*x1 - 18662400.0_wp*x3 + & - 13322233.0_wp ) / 8041092.0_wp - q(2,7) = 150.0_wp * ( -24192.0_wp*x1 + 338688.0_wp*x3 - & - 240463.0_wp ) / 670091.0_wp - q(3,7) = 54.0_wp * ( 134400.0_wp*x1 - 1693440.0_wp*x3 + & - 1191611.0_wp ) / 670091.0_wp - q(4,7) = 2.0_wp * ( -10886400.0_wp*x1 + 114307200.0_wp*x3 - & - 79048289.0_wp ) / 2010273.0_wp - q(5,7) = 15.0_wp * ( 967680.0_wp*x1 - 6773760.0_wp*x3 + & - 4472029.0_wp ) / 2680364.0_wp - q(6,7) = -725760.0_wp*x1 / 670091.0_wp; q(7,7) = zero - q(8,7) = 725760.0_wp*x3 / 670091.0_wp; q(9,7) = -145152.0_wp/670091.0_wp - q(10,7) = 27648.0_wp/670091.0_wp; q(11,7) = -2592.0_wp/670091.0_wp - q(12,7) = zero - - q(1,8) = 3.0_wp * ( 6773760.0_wp*x2 + 33868800.0_wp*x3 - & - 24839327.0_wp ) / 20510956.0_wp - q(2,8) = ( -152409600.0_wp*x2 - 731566080.0_wp*x3 + & - 536324953.0_wp ) / 30766434.0_wp - q(3,8) = 45.0_wp * ( 2257920.0_wp*x2 + 10160640.0_wp*x3 - & - 7439833.0_wp ) / 10255478.0_wp - q(4,8) = 75.0_wp * ( -1354752.0_wp*x2 - 5419008.0_wp*x3 + & - 3952831.0_wp ) / 10255478.0_wp - q(5,8) = ( 304819200.0_wp*x2 + 914457600.0_wp*x3 - & - 657798011.0_wp ) / 61532868.0_wp - q(6,8) = -5080320.0_wp*x2 / 5127739.0_wp - q(7,8) = -5080320.0_wp*x3 / 5127739.0_wp; q(8,8) = zero - q(9,8) = 4064256.0_wp/5127739.0_wp; q(10,8) = -1016064.0_wp/5127739.0_wp - q(11,8) = 193536.0_wp/5127739.0_wp; q(12,8) = -18144.0_wp/5127739.0_wp - + call coeffs_1_8_4 ( a, q ) first = .false. end if dd = zero imin = 0 - imax = -1 + imax = 0 if ( bb(1) == 0 ) then il = 1 + gsize diff --git a/src/Coefficients_8_4_min_err_coeff.F90 b/src/Coefficients_8_4_min_err_coeff.F90 new file mode 100644 index 0000000..836feec --- /dev/null +++ b/src/Coefficients_8_4_min_err_coeff.F90 @@ -0,0 +1,253 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine set_coeff_8_4_opt ( nsize, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(4), save :: a + CCTK_REAL, dimension(12,8), save :: q + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( first ) then + call coeffs_1_8_4_opt ( a, q ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dd(1:8,1) = q(1:8,1) + imin(1) = 1; imax(1) = 8 + + dd(1:8,2) = q(1:8,2) + imin(2) = 1; imax(2) = 8 + + dd(1:8,3) = q(1:8,3) + imin(3) = 1; imax(3) = 8 + + dd(1:8,4) = q(1:8,4) + imin(4) = 1; imax(4) = 8 + + dd(1:9,5) = q(1:9,5) + imin(5) = 1; imax(5) = 9 + + dd(1:10,6) = q(1:10,6) + imin(6) = 1; imax(6) = 10 + + dd(1:11,7) = q(1:11,7) + imin(7) = 1; imax(7) = 11 + + dd(1:12,8) = q(1:12,8) + imin(8) = 1; imax(8) = 12 + + il = 9 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + dd(nsize-11:nsize,nsize-7) = -q(12:1:-1,8) + imin(nsize-7) = nsize-11; imax(nsize-7) = nsize + + dd(nsize-10:nsize,nsize-6) = -q(11:1:-1,7) + imin(nsize-6) = nsize-10; imax(nsize-6) = nsize + + dd(nsize-9:nsize,nsize-5) = -q(10:1:-1,6) + imin(nsize-5) = nsize-9; imax(nsize-5) = nsize + + dd(nsize-8:nsize,nsize-4) = -q(9:1:-1,5) + imin(nsize-4) = nsize-8; imax(nsize-4) = nsize + + dd(nsize-7:nsize,nsize-3) = -q(8:1:-1,4) + imin(nsize-3) = nsize-7; imax(nsize-3) = nsize + + dd(nsize-7:nsize,nsize-2) = -q(8:1:-1,3) + imin(nsize-2) = nsize-7; imax(nsize-2) = nsize + + dd(nsize-7:nsize,nsize-1) = -q(8:1:-1,2) + imin(nsize-1) = nsize-7; imax(nsize-1) = nsize + + dd(nsize-7:nsize,nsize) = -q(8:1:-1,1) + imin(nsize) = nsize-7; imax(nsize) = nsize + + ir = nsize - 8 + end if + do i = il, ir + dd(i-4:i-1,i) = -a(4:1:-1); dd(i+1:i+4,i) = a(1:4) + imin(i) = i-4; imax(i) = i+4 + end do +end subroutine set_coeff_8_4_opt + +subroutine set_coeff_up_8_4_opt ( nsize, dir, loc_order, bb, gsize, imin, imax, dd ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: nsize, dir, loc_order + CCTK_INT, dimension(2), intent(IN) :: bb + CCTK_INT, intent(IN) :: gsize + CCTK_INT, dimension(nsize), intent(OUT) :: imin, imax + CCTK_REAL, dimension(nsize,nsize), intent(OUT) :: dd + + CCTK_REAL, dimension(-4:4), save :: a1, a2 + CCTK_REAL, dimension(12,8), save :: q1, q2 + + CCTK_INT :: i, il, ir + + logical, save :: first = .true. + + if ( .not. ( dir == -1 .or. dir == 1 ) ) then + call CCTK_WARN(0, 'Internal error: set_coeff_up_8_4_opt called with invalid dir value') + end if + + if ( first ) then + call coeffs_up_8_4_opt ( a1, q1, a2, q2 ) + first = .false. + end if + + dd = zero + imin = 0 + imax = 0 + + if ( bb(1) == 0 ) then + il = 1 + gsize + else + if ( dir == -1 ) then + dd(1:8,1) = q1(1:8,1) + imin(1) = 1; imax(1) = 8 + + dd(1:8,2) = q1(1:8,2) + imin(2) = 1; imax(2) = 8 + + dd(1:8,3) = q1(1:8,3) + imin(3) = 1; imax(3) = 8 + + dd(1:8,4) = q1(1:8,4) + imin(4) = 1; imax(4) = 8 + + dd(1:8,5) = q1(1:8,5) + imin(5) = 1; imax(5) = 8 + + dd(1:9,6) = q1(1:9,6) + imin(6) = 1; imax(6) = 9 + + dd(1:10,7) = q1(1:10,7) + imin(7) = 1; imax(7) = 10 + + dd(1:11,8) = q1(1:11,8) + imin(8) = 1; imax(8) = 11 + else + dd(1:8,1) = q2(1:8,1) + imin(1) = 1; imax(1) = 8 + + dd(1:8,2) = q2(1:8,2) + imin(2) = 1; imax(2) = 8 + + dd(1:8,3) = q2(1:8,3) + imin(3) = 1; imax(3) = 8 + + dd(1:8,4) = q2(1:8,4) + imin(4) = 1; imax(4) = 8 + + dd(1:9,5) = q2(1:9,5) + imin(5) = 1; imax(5) = 9 + + dd(1:10,6) = q2(1:10,6) + imin(6) = 1; imax(6) = 10 + + dd(1:11,7) = q2(1:11,7) + imin(7) = 1; imax(7) = 11 + + dd(1:12,8) = q2(1:12,8) + imin(8) = 1; imax(8) = 12 + end if + il = 9 + end if + if ( bb(2) == 0 ) then + ir = nsize - gsize + else + if ( dir == -1 ) then + dd(nsize-11:nsize,nsize-7) = -q2(12:1:-1,8) + imin(nsize-7) = nsize-11; imax(nsize-7) = nsize + + dd(nsize-10:nsize,nsize-6) = -q2(11:1:-1,7) + imin(nsize-6) = nsize-10; imax(nsize-6) = nsize + + dd(nsize-9:nsize,nsize-5) = -q2(10:1:-1,6) + imin(nsize-5) = nsize-9; imax(nsize-5) = nsize + + dd(nsize-8:nsize,nsize-4) = -q2(9:1:-1,5) + imin(nsize-4) = nsize-8; imax(nsize-4) = nsize + + dd(nsize-7:nsize,nsize-3) = -q2(8:1:-1,4) + imin(nsize-3) = nsize-7; imax(nsize-3) = nsize + + dd(nsize-7:nsize,nsize-2) = -q2(8:1:-1,3) + imin(nsize-2) = nsize-7; imax(nsize-2) = nsize + + dd(nsize-7:nsize,nsize-1) = -q2(8:1:-1,2) + imin(nsize-1) = nsize-7; imax(nsize-1) = nsize + + dd(nsize-7:nsize,nsize) = -q2(8:1:-1,1) + imin(nsize) = nsize-7; imax(nsize) = nsize + else + dd(nsize-10:nsize,nsize-7) = -q1(11:1:-1,8) + imin(nsize-7) = nsize-10; imax(nsize-7) = nsize + + dd(nsize-9:nsize,nsize-6) = -q1(10:1:-1,7) + imin(nsize-6) = nsize-9; imax(nsize-6) = nsize + + dd(nsize-8:nsize,nsize-5) = -q1(9:1:-1,6) + imin(nsize-5) = nsize-8; imax(nsize-5) = nsize + + dd(nsize-7:nsize,nsize-4) = -q1(8:1:-1,5) + imin(nsize-4) = nsize-7; imax(nsize-4) = nsize + + dd(nsize-7:nsize,nsize-3) = -q1(8:1:-1,4) + imin(nsize-3) = nsize-7; imax(nsize-3) = nsize + + dd(nsize-7:nsize,nsize-2) = -q1(8:1:-1,3) + imin(nsize-2) = nsize-7; imax(nsize-2) = nsize + + dd(nsize-7:nsize,nsize-1) = -q1(8:1:-1,2) + imin(nsize-1) = nsize-7; imax(nsize-1) = nsize + + dd(nsize-7:nsize,nsize) = -q1(8:1:-1,1) + imin(nsize) = nsize-7; imax(nsize) = nsize + end if + ir = nsize - 8 + end if + + do i = il, ir + if ( dir == -1 ) then + dd(i-4:i+3,i) = a1(-4:3) + imin(i) = i-4; imax(i) = i+3 + else + dd(i-3:i+4,i) = a2(-3:4) + imin(i) = i-3; imax(i) = i+4 + end if + end do +end subroutine set_coeff_up_8_4_opt diff --git a/src/Derivatives2_2_1.F90 b/src/Derivatives2_2_1.F90 new file mode 100644 index 0000000..a02f890 --- /dev/null +++ b/src/Derivatives2_2_1.F90 @@ -0,0 +1,119 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine deriv2_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar2 ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: ni, nj, nk + CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var + CCTK_INT, intent(IN) :: dir + CCTK_INT, intent(IN) :: bb(2) + CCTK_INT, intent(IN) :: gsize + CCTK_REAL, intent(IN) :: delta + CCTK_REAL, dimension(ni,nj,nk), intent(OUT) :: dvar2 + + CCTK_REAL, dimension(2), save :: a + CCTK_REAL, dimension(3,2), save :: q + CCTK_REAL :: idel2 + + CCTK_INT :: il, ir, jl, jr, kl, kr + + logical, save :: first = .true. + + if ( first ) then + call coeffs_2_2_1 ( a, q ) + first = .false. + end if + + idel2 = 1.0_wp / delta**2 + + direction: select case (dir) + case (0) direction + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dvar2(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) + & + q(3,1) * var(3,:,:) ) * idel2 + dvar2(2,:,:) = ( q(1,2) * var(1,:,:) + q(2,2) * var(2,:,:) + & + q(3,2) * var(3,:,:) ) * idel2 + il = 3 + end if + if ( bb(2) == 0 ) then + ir = ni - gsize + else + dvar2(ni-1,:,:) = ( q(1,2) * var(ni,:,:) + & + q(2,2) * var(ni-1,:,:) + & + q(3,2) * var(ni-2,:,:) ) * idel2 + dvar2(ni,:,:) = ( q(1,1) * var(ni,:,:) + & + q(2,1) * var(ni-1,:,:) + & + q(3,1) * var(ni-2,:,:) ) * idel2 + ir = ni - 2 + end if + dvar2(il:ir,:,:) = ( a(2) * ( var(il+1:ir+1,:,:) + & + var(il-1:ir-1,:,:) ) + & + a(1) * var(il:ir,:,:) ) * idel2 + case (1) direction + if ( zero_derivs_y /= 0 ) then + dvar2 = zero + else + if ( bb(1) == 0 ) then + jl = 1 + gsize + else + dvar2(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) + & + q(3,1) * var(:,3,:) ) * idel2 + dvar2(:,2,:) = ( q(1,2) * var(:,1,:) + q(2,2) * var(:,2,:) + & + q(3,2) * var(:,3,:) ) * idel2 + jl = 3 + end if + if ( bb(2) == 0 ) then + jr = nj - gsize + else + dvar2(:,nj-1,:) = ( q(1,2) * var(:,nj,:) + & + q(2,2) * var(:,nj-1,:) + & + q(3,2) * var(:,nj-2,:) ) * idel2 + dvar2(:,nj,:) = ( q(1,1) * var(:,nj,:) + & + q(2,1) * var(:,nj-1,:) + & + q(3,1) * var(:,nj-2,:) ) * idel2 + jr = nj - 2 + end if + dvar2(:,jl:jr,:) = ( a(2) * ( var(:,jl+1:jr+1,:) + & + var(:,jl-1:jr-1,:) ) + & + a(1) * var(:,jl:jr,:) ) * idel2 + end if + case (2) direction + if ( zero_derivs_z /= 0 ) then + dvar2 = zero + else + if ( bb(1) == 0 ) then + kl = 1 + gsize + else + dvar2(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) + & + q(3,1) * var(:,:,3) ) * idel2 + dvar2(:,:,2) = ( q(1,2) * var(:,:,1) + q(2,2) * var(:,:,2) + & + q(3,2) * var(:,:,3) ) * idel2 + kl = 3 + end if + if ( bb(2) == 0 ) then + kr = nk - gsize + else + dvar2(:,:,nk-1) = ( q(1,2) * var(:,:,nk) + & + q(2,2) * var(:,:,nk-1) + & + q(3,2) * var(:,:,nk-2) ) * idel2 + dvar2(:,:,nk) = ( q(1,1) * var(:,:,nk) + & + q(2,1) * var(:,:,nk-1) + & + q(3,1) * var(:,:,nk-2) ) * idel2 + kr = nk - 2 + end if + dvar2(:,:,kl:kr) = ( a(2) * ( var(:,:,kl+1:kr+1) + & + var(:,:,kl-1:kr-1) ) + & + a(1) * var(:,:,kl:kr) ) * idel2 + end if + end select direction +end subroutine deriv2_gf_2_1 diff --git a/src/Derivatives2_4_2.F90 b/src/Derivatives2_4_2.F90 new file mode 100644 index 0000000..1827966 --- /dev/null +++ b/src/Derivatives2_4_2.F90 @@ -0,0 +1,201 @@ +#include "cctk.h" +#include "cctk_Functions.h" +#include "cctk_Parameters.h" + +subroutine deriv2_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar2 ) + + use All_Coeffs_mod + + implicit none + + DECLARE_CCTK_FUNCTIONS + DECLARE_CCTK_PARAMETERS + + CCTK_INT, intent(IN) :: ni, nj, nk + CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var + CCTK_INT, intent(IN) :: dir + CCTK_INT, intent(IN) :: bb(2) + CCTK_INT, intent(IN) :: gsize + CCTK_REAL, intent(IN) :: delta + CCTK_REAL, dimension(ni,nj,nk), intent(OUT) :: dvar2 + + CCTK_REAL, dimension(3), save :: a + CCTK_REAL, dimension(6,4), save :: q + CCTK_REAL :: idel2 + + CCTK_INT :: il, ir, jl, jr, kl, kr + + logical, save :: first = .true. + + if ( first ) then + call coeffs_2_4_2 ( a, q ) + first = .false. + end if + + idel2 = 1.0_wp / delta**2 + + direction: select case (dir) + case (0) direction + if ( bb(1) == 0 ) then + il = 1 + gsize + else + dvar2(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) + & + q(3,1) * var(3,:,:) + q(4,1) * var(4,:,:) + & + q(6,1) * var(6,:,:) ) * idel2 + dvar2(2,:,:) = ( q(1,2) * var(1,:,:) + q(2,2) * var(2,:,:) + & + q(3,2) * var(3,:,:) + q(4,2) * var(4,:,:) + & + q(5,2) * var(5,:,:) + q(6,2) * var(6,:,:) ) * idel2 + dvar2(3,:,:) = ( q(1,3) * var(1,:,:) + q(2,3) * var(2,:,:) + & + q(3,3) * var(3,:,:) + q(4,3) * var(4,:,:) + & + q(5,3) * var(5,:,:) + q(6,3) * var(6,:,:) ) * idel2 + dvar2(4,:,:) = ( q(1,4) * var(1,:,:) + q(2,4) * var(2,:,:) + & + q(3,4) * var(3,:,:) + q(4,4) * var(4,:,:) + & + q(5,4) * var(5,:,:) + q(6,4) * var(6,:,:) ) * idel2 + il = 5 + end if + if ( bb(2) == 0 ) then + ir = ni - gsize + else + dvar2(ni-3,:,:) = ( q(1,4) * var(ni,:,:) + & + q(2,4) * var(ni-1,:,:) + & + q(3,4) * var(ni-2,:,:) + & + q(4,4) * var(ni-3,:,:) + & + q(5,4) * var(ni-4,:,:) + & + q(6,4) * var(ni-5,:,:) ) * idel2 + dvar2(ni-2,:,:) = ( q(1,3) * var(ni,:,:) + & + q(2,3) * var(ni-1,:,:) + & + q(3,3) * var(ni-2,:,:) + & + q(4,3) * var(ni-3,:,:) + & + q(5,3) * var(ni-4,:,:) + & + q(6,3) * var(ni-5,:,:) ) * idel2 + dvar2(ni-1,:,:) = ( q(1,2) * var(ni,:,:) + & + q(2,2) * var(ni-1,:,:) + & + q(3,2) * var(ni-2,:,:) + & + q(4,2) * var(ni-3,:,:) + & + q(5,2) * var(ni-4,:,:) + & + q(6,2) * var(ni-5,:,:) ) * idel2 + dvar2(ni,:,:) = ( q(1,1) * var(ni,:,:) + & + q(2,1) * var(ni-1,:,:) + & + q(3,1) * var(ni-2,:,:) + & + q(4,1) * var(ni-3,:,:) + & + q(6,1) * var(ni-5,:,:) ) * idel2 + ir = ni - 4 + end if + dvar2(il:ir,:,:) = ( a(1) * var(il:ir,:,:) + & + a(2) * ( var(il+1:ir+1,:,:) + & + var(il-1:ir-1,:,:) ) + & + a(3) * ( var(il+2:ir+2,:,:) + & + var(il-2:ir-2,:,:) ) ) * idel2 + case (1) direction + if ( zero_derivs_y /= 0 ) then + dvar2 = zero + else + if ( bb(1) == 0 ) then + jl = 1 + gsize + else + dvar2(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) + & + q(3,1) * var(:,3,:) + q(4,1) * var(:,4,:) + & + q(6,1) * var(:,6,:) ) * idel2 + dvar2(:,2,:) = ( q(1,2) * var(:,1,:) + q(2,2) * var(:,2,:) + & + q(3,2) * var(:,3,:) + q(4,2) * var(:,4,:) + & + q(5,2) * var(:,5,:) + q(6,2) * var(:,6,:) ) * idel2 + dvar2(:,3,:) = ( q(1,3) * var(:,1,:) + q(2,3) * var(:,2,:) + & + q(3,3) * var(:,3,:) + q(4,3) * var(:,4,:) + & + q(5,3) * var(:,5,:) + q(6,3) * var(:,6,:) ) * idel2 + dvar2(:,4,:) = ( q(1,4) * var(:,1,:) + q(2,4) * var(:,2,:) + & + q(3,4) * var(:,3,:) + q(4,4) * var(:,4,:) + & + q(5,4) * var(:,5,:) + q(6,4) * var(:,6,:) ) * idel2 + jl = 5 + end if + if ( bb(2) == 0 ) then + jr = nj - gsize + else + dvar2(:,nj-3,:) = ( q(1,4) * var(:,nj,:) + & + q(2,4) * var(:,nj-1,:) + & + q(3,4) * var(:,nj-2,:) + & + q(4,4) * var(:,nj-3,:) + & + q(5,4) * var(:,nj-4,:) + & + q(6,4) * var(:,nj-5,:) ) * idel2 + dvar2(:,nj-2,:) = ( q(1,3) * var(:,nj,:) + & + q(2,3) * var(:,nj-1,:) + & + q(3,3) * var(:,nj-2,:) + & + q(4,3) * var(:,nj-3,:) + & + q(5,3) * var(:,nj-4,:) + & + q(6,3) * var(:,nj-5,:) ) * idel2 + dvar2(:,nj-1,:) = ( q(1,2) * var(:,nj,:) + & + q(2,2) * var(:,nj-1,:) + & + q(3,2) * var(:,nj-2,:) + & + q(4,2) * var(:,nj-3,:) + & + q(5,2) * var(:,nj-4,:) + & + q(6,2) * var(:,nj-5,:) ) * idel2 + dvar2(:,nj,:) = ( q(1,1) * var(:,nj,:) + & + q(2,1) * var(:,nj-1,:) + & + q(3,1) * var(:,nj-2,:) + & + q(4,1) * var(:,nj-3,:) + & + q(6,1) * var(:,nj-5,:) ) * idel2 + jr = nj - 4 + end if + dvar2(:,jl:jr,:) = ( a(1) * var(:,jl:jr,:) + & + a(2) * ( var(:,jl+1:jr+1,:) + & + var(:,jl-1:jr-1,:) ) + & + a(3) * ( var(:,jl+2:jr+2,:) + & + var(:,jl-2:jr-2,:) ) ) * idel2 + + end if + case (2) direction + if ( zero_derivs_z /= 0 ) then + dvar2 = zero + else + if ( bb(1) == 0 ) then + kl = 1 + gsize + else + dvar2(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) + & + q(3,1) * var(:,:,3) + q(4,1) * var(:,:,4) + & + q(6,1) * var(:,:,6) ) * idel2 + dvar2(:,:,2) = ( q(1,2) * var(:,:,1) + q(2,2) * var(:,:,2) + & + q(3,2) * var(:,:,3) + q(4,2) * var(:,:,4) + & + q(5,2) * var(:,:,5) + q(6,2) * var(:,:,6) ) * idel2 + dvar2(:,:,3) = ( q(1,3) * var(:,:,1) + q(2,3) * var(:,:,2) + & + q(3,3) * var(:,:,3) + q(4,3) * var(:,:,4) + & + q(5,3) * var(:,:,5) + q(6,3) * var(:,:,6) ) * idel2 + dvar2(:,:,4) = ( q(1,4) * var(:,:,1) + q(2,4) * var(:,:,2) + & + q(3,4) * var(:,:,3) + q(4,4) * var(:,:,4) + & + q(5,4) * var(:,:,5) + q(6,4) * var(:,:,6) ) * idel2 + kl = 5 + end if + if ( bb(2) == 0 ) then + kr = nk - gsize + else + dvar2(:,:,nk-3) = ( q(1,4) * var(:,:,nk) + & + q(2,4) * var(:,:,nk-1) + & + q(3,4) * var(:,:,nk-2) + & + q(4,4) * var(:,:,nk-3) + & + q(5,4) * var(:,:,nk-4) + & + q(6,4) * var(:,:,nk-5) ) * idel2 + dvar2(:,:,nk-2) = ( q(1,3) * var(:,:,nk) + & + q(2,3) * var(:,:,nk-1) + & + q(3,3) * var(:,:,nk-2) + & + q(4,3) * var(:,:,nk-3) + & + q(5,3) * var(:,:,nk-4) + & + q(6,3) * var(:,:,nk-5) ) * idel2 + dvar2(:,:,nk-1) = ( q(1,2) * var(:,:,nk) + & + q(2,2) * var(:,:,nk-1) * & + q(3,2) * var(:,:,nk-2) * & + q(4,2) * var(:,:,nk-3) * & + q(5,2) * var(:,:,nk-4) * & + q(6,2) * var(:,:,nk-5) ) * idel2 + dvar2(:,:,nk) = ( q(1,1) * var(:,:,nk) + & + q(2,1) * var(:,:,nk-1) + & + q(3,1) * var(:,:,nk-2) + & + q(4,1) * var(:,:,nk-3) + & + q(6,1) * var(:,:,nk-5) ) * idel2 + kr = nk - 4 + end if + dvar2(:,:,kl:kr) = ( a(1) * var(:,:,kl:kr) + & + a(2) * ( var(:,:,kl+1:kr+1) + & + var(:,:,kl-1:kr-1) ) + & + a(3) * ( var(:,:,kl+2:kr+2) + & + var(:,:,kl-2:kr-2) ) ) * idel2 + end if + end select direction +end subroutine deriv2_gf_4_2 diff --git a/src/Derivatives_2_1.F90 b/src/Derivatives_2_1.F90 index 788d325..4ea8593 100644 --- a/src/Derivatives_2_1.F90 +++ b/src/Derivatives_2_1.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,10 +28,7 @@ subroutine deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 1.0_wp/2.0_wp - - q(1,1) = -1.0_wp; q(2,1) = 1.0_wp; q(3,1) = zero - q(1,2) = -1.0_wp/2.0_wp; q(2,2) = zero; q(3,2) = 1.0_wp/2.0_wp + call coeffs_1_2_1 ( a, q ) first = .false. end if @@ -112,13 +109,13 @@ end subroutine deriv_gf_2_1 subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -137,28 +134,7 @@ subroutine up_deriv_gf_2_1 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) logical, save :: first = .true. if ( first ) then - a1(-1) = -1.000000000000000000000000000000000000000_wp - a1(0) = 1.000000000000000000000000000000000000000_wp - a1(1) = 0.0_wp - - q1(1,1) = 0.0_wp - q1(2,1) = 0.0_wp - q1(3,1) = 0.0_wp - q1(1,2) = -1.000000000000000000000000000000000000000_wp - q1(2,2) = 1.000000000000000000000000000000000000000_wp - q1(3,2) = 0.0_wp - - a2(-1) = 0.0_wp - a2(0) = -1.000000000000000000000000000000000000000_wp - a2(1) = 1.000000000000000000000000000000000000000_wp - - q2(1,1) = -2.000000000000000000000000000000000000000_wp - q2(2,1) = 2.000000000000000000000000000000000000000_wp - q2(3,1) = 0.0_wp - q2(1,2) = 0.0_wp - q2(2,2) = -1.000000000000000000000000000000000000000_wp - q2(3,2) = 1.000000000000000000000000000000000000000_wp - + call coeffs_up_2_1 ( a1, q1, a2, q2 ) first = .false. end if diff --git a/src/Derivatives_4_2.F90 b/src/Derivatives_4_2.F90 index fb6888f..3a9465e 100644 --- a/src/Derivatives_4_2.F90 +++ b/src/Derivatives_4_2.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,20 +28,7 @@ subroutine deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 2.0_wp/3.0_wp; a(2) = -1.0_wp/12.0_wp - - q(1,1) = -24.0_wp/17.0_wp; q(2,1) = 59.0_wp/34.0_wp - q(3,1) = -4.0_wp/17.0_wp; q(4,1) = -3.0_wp/34.0_wp - q(5,1) = zero; q(6,1) = zero - q(1,2) = -1.0_wp/2.0_wp; q(2,2) = zero - q(3,2) = 1.0_wp/2.0_wp; q(4,2) = zero - q(5,2) = zero; q(6,2) = zero - q(1,3) = 4.0_wp/43.0_wp; q(2,3) = -59.0_wp/86.0_wp - q(3,3) = zero; q(4,3) = 59.0_wp/86.0_wp - q(5,3) = -4.0_wp/43.0_wp; q(6,3) = zero - q(1,4) = 3.0_wp/98.0_wp; q(2,4) = zero - q(3,4) = -59.0_wp/98.0_wp; q(4,4) = zero - q(5,4) = 32.0_wp/49.0_wp; q(6,4) = -4.0_wp/49.0_wp + call coeffs_1_4_2 ( a, q ) first = .false. end if @@ -174,13 +161,13 @@ end subroutine deriv_gf_4_2 subroutine up_deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -199,68 +186,7 @@ subroutine up_deriv_gf_4_2 ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) logical, save :: first = .true. if ( first ) then - a1(-2) = 0.1666666666666666666666666666666666666667_wp - a1(-1) = -1.000000000000000000000000000000000000000_wp - a1(0) = 0.5000000000000000000000000000000000000000_wp - a1(1) = 0.3333333333333333333333333333333333333333_wp - a1(2) = 0.0_wp - - q1(1,1) = -1.176470588235294117647058823529411764706_wp - q1(2,1) = 1.264705882352941176470588235294117647059_wp - q1(3,1) = 0.0_wp - q1(4,1) = -0.08823529411764705882352941176470588235294_wp - q1(5,1) = 0.0_wp - q1(6,1) = 0.0_wp - q1(1,2) = -0.6355932203389830508474576271186440677966_wp - q1(2,2) = 0.3389830508474576271186440677966101694915_wp - q1(3,2) = 0.2288135593220338983050847457627118644068_wp - q1(4,2) = 0.06779661016949152542372881355932203389831_wp - q1(5,2) = 0.0_wp - q1(6,2) = 0.0_wp - q1(1,3) = 0.1860465116279069767441860465116279069767_wp - q1(2,3) = -1.058139534883720930232558139534883720930_wp - q1(3,3) = 0.5581395348837209302325581395348837209302_wp - q1(4,3) = 0.3139534883720930232558139534883720930233_wp - q1(5,3) = 0.0_wp - q1(6,3) = 0.0_wp - q1(1,4) = 0.03061224489795918367346938775510204081633_wp - q1(2,4) = 0.08163265306122448979591836734693877551020_wp - q1(3,4) = -0.9285714285714285714285714285714285714286_wp - q1(4,4) = 0.4897959183673469387755102040816326530612_wp - q1(5,4) = 0.3265306122448979591836734693877551020408_wp - q1(6,4) = 0.0_wp - - a2(-2) = 0.0_wp - a2(-1) = -0.3333333333333333333333333333333333333333_wp - a2(0) = -0.5000000000000000000000000000000000000000_wp - a2(1) = 1.000000000000000000000000000000000000000_wp - a2(2) = -0.1666666666666666666666666666666666666667_wp - - q2(1,1) = -1.647058823529411764705882352941176470588_wp - q2(2,1) = 2.205882352941176470588235294117647058824_wp - q2(3,1) = -0.4705882352941176470588235294117647058824_wp - q2(4,1) = -0.08823529411764705882352941176470588235294_wp - q2(5,1) = 0.0_wp - q2(6,1) = 0.0_wp - q2(1,2) = -0.3644067796610169491525423728813559322034_wp - q2(2,2) = -0.3389830508474576271186440677966101694915_wp - q2(3,2) = 0.7711864406779661016949152542372881355932_wp - q2(4,2) = -0.06779661016949152542372881355932203389831_wp - q2(5,2) = 0.0_wp - q2(6,2) = 0.0_wp - q2(1,3) = 0.0_wp - q2(2,3) = -0.3139534883720930232558139534883720930233_wp - q2(3,3) = -0.5581395348837209302325581395348837209302_wp - q2(4,3) = 1.058139534883720930232558139534883720930_wp - q2(5,3) = -0.1860465116279069767441860465116279069767_wp - q2(6,3) = 0.0_wp - q2(1,4) = 0.03061224489795918367346938775510204081633_wp - q2(2,4) = -0.08163265306122448979591836734693877551020_wp - q2(3,4) = -0.2755102040816326530612244897959183673469_wp - q2(4,4) = -0.4897959183673469387755102040816326530612_wp - q2(5,4) = 0.9795918367346938775510204081632653061224_wp - q2(6,4) = -0.1632653061224489795918367346938775510204_wp - + call coeffs_up_4_2 ( a1, q1, a2, q2 ) first = .false. end if diff --git a/src/Derivatives_4_3.F90 b/src/Derivatives_4_3.F90 index d40c7b6..19a012e 100644 --- a/src/Derivatives_4_3.F90 +++ b/src/Derivatives_4_3.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -22,66 +22,13 @@ subroutine deriv_gf_4_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) CCTK_REAL, dimension(2), save :: a CCTK_REAL, dimension(7,5), save :: q CCTK_REAL :: idel - CCTK_REAL :: f0, f1, f2, f3 CCTK_INT :: il, ir, jl, jr, kl, kr logical, save :: first = .true. if ( first ) then - a(1) = 2.0_wp/3.0_wp; a(2) = -1.0_wp/12.0_wp - - f0 = sqrt(26116897.0_wp) - f1 = -56764003702447356523.0_wp + 8154993476273221.0_wp * f0 - f2 = -55804550303.0_wp + 9650225.0_wp * f0 - f3 = 3262210757.0_wp + 271861.0_wp * f0 - - q(1,1) = -11._wp/6.0_wp; q(2,1) = 3.0_wp - q(3,1) = -3.0_wp/2.0_wp; q(4,1) = 1.0_wp/3.0_wp - q(5,1) = zero; q(6,1) = zero; q(7,1) = zero - - q(1,2) = -24.0_wp * ( -779042810827742869.0_wp + & - 104535124033147.0_wp * f0 ) / f1 - q(2,2) = -( -176530817412806109689.0_wp + & - 29768274816875927.0_wp * f0 ) / ( 6.0_wp * f1 ) - q(3,2) = 343.0_wp * ( -171079116122226871.0_wp + & - 27975630462649.0_wp * f0 ) / f1 - q(4,2) = -3.0_wp * ( -7475554291248533227.0_wp + & - 1648464218793925.0_wp * f0 ) / ( 2.0_wp * f1 ) - q(5,2) = ( -2383792768180030915.0_wp + & - 1179620587812973.0_wp * f0 ) / ( 3.0_wp * f1 ) - q(6,2) = -1232.0_wp * ( -115724529581315.0_wp + 37280576429.0_wp * f0 ) / f1 - q(7,2) = zero - - q(1,3) = -12.0_wp * ( -380966843.0_wp + 86315.0_wp * f0 ) / f2 - q(2,3) = ( 5024933015.0_wp + 2010631.0_wp * f0 ) / ( 3.0_wp * f2 ) - q(3,3) = -231.0_wp * ( -431968921.0_wp + 86711.0_wp * f0 ) / ( 2.0_wp * f2 ) - q(4,3) = ( -65931742559.0_wp + 12256337.0_wp * f0 ) / f2 - q(5,3) = -( -50597298167.0_wp + 9716873.0_wp * f0 ) / ( 6.0_wp * f2 ) - q(6,3) = -88.0_wp * ( -15453061.0_wp + 2911.0_wp * f0 ) / f2 - q(7,3) = zero - - q(1,4) = 48.0_wp * ( -56020909845192541.0_wp + & - 9790180507043.0_wp * f0 ) / f1 - q(2,4) = ( -9918249049237586011.0_wp + & - 1463702013196501.0_wp * f0 ) / ( 6.0_wp * f1) - q(3,4) = -13.0_wp * ( -4130451756851441723.0_wp + & - 664278707201077.0_wp * f0 ) / f1 - q(4,4) = 3.0_wp * ( -26937108467782666617.0_wp + & - 5169063172799767.0_wp * f0 ) / ( 2.0_wp * f1 ) - q(5,4) = -( 6548308508012371315.0_wp + & - 3968886380989379.0_wp * f0 ) / ( 3.0_wp * f1 ) - q(6,4) = 88.0_wp * ( -91337851897923397.0_wp + & - 19696768305507.0_wp * f0 ) / f1 - q(7,4) = 242.0_wp * ( -120683.0_wp + 15.0_wp * f0 ) / f3 - - q(1,5) = 264.0_wp * ( -120683.0_wp + 15.0_wp * f0 ) / f3 - q(2,5) = ( -43118111.0_wp + 23357.0_wp * f0 ) / ( 3.0_wp * f3 ) - q(3,5) = -47.0_wp * ( -28770085.0_wp + 2259.0_wp * f0 ) / ( 2.0_wp * f3 ) - q(4,5) = -3.0_wp * ( 1003619433.0_wp + 11777.0_wp * f0 ) / f3 - q(5,5) = -11.0_wp * ( -384168269.0_wp + 65747.0_wp * f0 ) / ( 6.0_wp * f3 ) - q(6,5) = 22.0_wp * ( 87290207.0_wp + 10221.0_wp * f0 ) / f3 - q(7,5) = -66.0_wp * ( 3692405.0_wp + 419.0_wp * f0 ) / f3 + call coeffs_1_4_3 ( a, q ) first = .false. end if diff --git a/src/Derivatives_4_3_min_err_coeff.F90 b/src/Derivatives_4_3_min_err_coeff.F90 index b42d857..7bc0a82 100644 --- a/src/Derivatives_4_3_min_err_coeff.F90 +++ b/src/Derivatives_4_3_min_err_coeff.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,44 +28,7 @@ subroutine deriv_gf_4_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 2.0_wp/3.0_wp; a(2) = -1.0_wp/12.0_wp - - q(1,1) = -2.09329763466349871588733_wp - q(2,1) = 4.0398572053206615302160_wp - q(3,1) = -3.0597858079809922953240_wp - q(4,1) = 1.37319053865399486354933_wp - q(5,1) = -0.25996430133016538255400_wp - q(6,1) = 0.0_wp - q(7,1) = 0.0_wp - q(1,2) = -0.31641585285940445272297_wp - q(2,2) = -0.53930788973980422327388_wp - q(3,2) = 0.98517732028644343383297_wp - q(4,2) = -0.05264665989297578146709_wp - q(5,2) = -0.113807251750624235013258_wp - q(6,2) = 0.039879767889849911803103_wp - q(7,2) = -0.0028794339334846531588787_wp - q(1,3) = 0.13026916185021164524452_wp - q(2,3) = -0.87966858995059249256890_wp - q(3,3) = 0.38609640961100070000134_wp - q(4,3) = 0.31358369072435588745988_wp - q(5,3) = 0.085318941913678384633511_wp - q(6,3) = -0.039046615792734640274641_wp - q(7,3) = 0.0034470016440805155042908_wp - q(1,4) = -0.01724512193824647912172_wp - q(2,4) = 0.16272288227127504381134_wp - q(3,4) = -0.81349810248648813029217_wp - q(4,4) = 0.13833269266479833215645_wp - q(5,4) = 0.59743854328548053399616_wp - q(6,4) = -0.066026434346299887619324_wp - q(7,4) = -0.0017244594505194129307249_wp - q(1,5) = -0.00883569468552192965061_wp - q(2,5) = 0.03056074759203203857284_wp - q(3,5) = 0.05021168274530854232278_wp - q(4,5) = -0.66307364652444929534068_wp - q(5,5) = 0.014878787464005191116088_wp - q(6,5) = 0.65882706381707471953820_wp - q(7,5) = -0.082568940408449266558615_wp - + call coeffs_1_4_3_opt ( a, q ) first = .false. end if diff --git a/src/Derivatives_6_3.F90 b/src/Derivatives_6_3.F90 index 0e1b024..e194482 100644 --- a/src/Derivatives_6_3.F90 +++ b/src/Derivatives_6_3.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_6_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,33 +28,7 @@ subroutine deriv_gf_6_3 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp - - q(1,1) = -21600.0_wp/13649.0_wp; q(2,1) = 81763.0_wp/40947.0_wp - q(3,1) = 131.0_wp/27298.0_wp; q(4,1) = -9143.0_wp/13649.0_wp - q(5,1) = 20539.0_wp/81894.0_wp; q(6,1) = zero; - q(7,1) = zero; q(8,1) = zero; q(9,1) = zero - q(1,2) = -81763.0_wp/180195.0_wp; q(2,2) = zero - q(3,2) = 7357.0_wp/36039.0_wp; q(4,2) = 30637.0_wp/72078.0_wp - q(5,2) = -2328.0_wp/12013.0_wp; q(6,2) = 6611.0_wp/360390.0_wp - q(7,2) = zero; q(8,2) = zero; q(9,2) = zero - q(1,3) = -131.0_wp/54220.0_wp; q(2,3) = -7357.0_wp/16266.0_wp - q(3,3) = zero; q(4,3) = 645.0_wp/2711.0_wp - q(5,3) = 11237.0_wp/32532.0_wp; q(6,3) = -3487.0_wp/27110.0_wp - q(7,3) = zero; q(8,3) = zero; q(9,3) = zero - q(1,4) = 9143.0_wp/53590.0_wp; q(2,4) = -30637.0_wp/64308.0_wp - q(3,4) = -645.0_wp/5359.0_wp; q(4,4) = zero - q(5,4) = 13733.0_wp/32154.0_wp; q(6,4) = -67.0_wp/4660.0_wp - q(7,4) = 72.0_wp/5359.0_wp; q(8,4) = zero; q(9,4) = zero; - q(1,5) = -20539.0_wp/236310.0_wp; q(2,5) = 2328.0_wp/7877.0_wp - q(3,5) = -11237.0_wp/47262.0_wp; q(4,5) = -13733.0_wp/23631.0_wp - q(5,5) = zero; q(6,5) = 89387.0_wp/118155.0_wp - q(7,5) = -1296.0_wp/7877.0_wp; q(8,5) = 144.0_wp/7877.0_wp; q(9,5) = zero - q(1,6) = zero; q(2,6) = -6611.0_wp/262806.0_wp - q(3,6) = 3487.0_wp/43801.0_wp; q(4,6) = 1541.0_wp/87602.0_wp - q(5,6) = -89387.0_wp/131403.0_wp; q(6,6) = zero - q(7,6) = 32400.0_wp/43801.0_wp; q(8,6) = -6480.0_wp/43801.0_wp - q(9,6) = 720.0_wp/43801.0_wp + call coeffs_1_6_3 ( a, q ) first = .false. end if diff --git a/src/Derivatives_6_3_min_err_coeff.F90 b/src/Derivatives_6_3_min_err_coeff.F90 index b2d00e7..bf8b8f2 100644 --- a/src/Derivatives_6_3_min_err_coeff.F90 +++ b/src/Derivatives_6_3_min_err_coeff.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,63 +28,7 @@ subroutine deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp - - q(1,1) = -1.582533518939116418785258993332844897062_wp - q(2,1) = 2.033426786468126253898161347360808173712_wp - q(3,1) = -0.1417052898146741610733887894481170575600_wp - q(4,1) = -0.4501096599735708523162117824920488989702_wp - q(5,1) = 0.1042956382142412661862395105494407610836_wp - q(6,1) = 0.03662604404499391209045870736276191879693_wp - q(7,1) = 0.0_wp - q(8,1) = 0.0_wp - q(9,1) = 0.0_wp - q(1,2) = -0.4620701275035953590186631853846278325646_wp - q(2,2) = 0.0_wp - q(3,2) = 0.2873679417026202568532985205129449923126_wp - q(4,2) = 0.2585974499280928196267362923074433487080_wp - q(5,2) = -0.06894808744606961472005221923058251153103_wp - q(6,2) = -0.01494717668104810274131940820517799692506_wp - q(7,2) = 0.0_wp - q(8,2) = 0.0_wp - q(9,2) = 0.0_wp - q(1,3) = 0.07134398748360337973038301686379010397038_wp - q(2,3) = -0.6366933020423417826592908754928085932593_wp - q(3,3) = 0.0_wp - q(4,3) = 0.6067199374180168986519150843189505198519_wp - q(5,3) = -0.02338660408468356531858175098561718651857_wp - q(6,3) = -0.01798401877459493040442547470431484404443_wp - q(7,3) = 0.0_wp - q(8,3) = 0.0_wp - q(9,3) = 0.0_wp - q(1,4) = 0.1146397975178068401430112823144985150596_wp - q(2,4) = -0.2898424301162697370942324201800071793273_wp - q(3,4) = -0.3069262456316931913128086944558079603132_wp - q(4,4) = 0.0_wp - q(5,4) = 0.5203848121857539166740071338174418292578_wp - q(6,4) = -0.05169127637022742348368508279860701098408_wp - q(7,4) = 0.01343534241462959507370778130248180630715_wp - q(8,4) = 0.0_wp - q(9,4) = 0.0_wp - q(1,5) = -0.03614399304268576976452921364705641609825_wp - q(2,5) = 0.1051508663818248421520867474440761344449_wp - q(3,5) = 0.01609777419666805778308369351834662756172_wp - q(4,5) = -0.7080721616106272031118456849378369336023_wp - q(5,5) = 0.0_wp - q(6,5) = 0.7692160858661111736140494493705980473867_wp - q(7,5) = -0.1645296432652024882569506157166433921544_wp - q(8,5) = 0.01828107147391138758410562396851593246160_wp - q(9,5) = 0.0_wp - q(1,6) = -0.01141318406360863692889821914555232596651_wp - q(2,6) = 0.02049729840293952857599941220163960606616_wp - q(3,6) = 0.01113095018331244864875173213474522093204_wp - q(4,6) = 0.06324365883611076515355091406993789453750_wp - q(5,6) = -0.6916640154753724474963890679085181638850_wp - q(6,6) = 0.0_wp - q(7,6) = 0.7397091390607520376247117645715851236273_wp - q(8,6) = -0.1479418278121504075249423529143170247255_wp - q(9,6) = 0.01643798086801671194721581699047966941394_wp - + call coeffs_1_6_3_opt ( a, q ) first = .false. end if @@ -295,13 +239,13 @@ end subroutine deriv_gf_6_3_opt subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -320,132 +264,7 @@ subroutine up_deriv_gf_6_3_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva logical, save :: first = .true. if ( first ) then - a1(-3) = -0.03333333333333333333333333333333333333333_wp - a1(-2) = 0.2500000000000000000000000000000000000000_wp - a1(-1) = -1.000000000000000000000000000000000000000_wp - a1(0) = 0.3333333333333333333333333333333333333333_wp - a1(1) = 0.5000000000000000000000000000000000000000_wp - a1(2) = -0.05000000000000000000000000000000000000000_wp - a1(3) = 0.0_wp - - q1(1,1) = -1.529782401641145871492417026888416733827_wp - q1(2,1) = 1.875173434574214612019635448027523684006_wp - q1(3,1) = 0.01654806207923748080513710988516743214616_wp - q1(4,1) = -0.5028607772715413996090537489364770622056_wp - q1(5,1) = 0.1042956382142412661862395105494407610836_wp - q1(6,1) = 0.03662604404499391209045870736276191879693_wp - q1(7,1) = 0.0_wp - q1(8,1) = 0.0_wp - q1(9,1) = 0.0_wp - q1(1,2) = -0.4980311697078740570957463452947252270539_wp - q1(2,2) = 0.1198701406809289935902771997003246482977_wp - q1(3,2) = 0.1435237728855054645449658808725554143554_wp - q1(4,2) = 0.3305195343366502157809026121276381376866_wp - q1(5,2) = -0.08093510151416251407907993920061497636080_wp - q1(6,2) = -0.01494717668104810274131940820517799692506_wp - q1(7,2) = 0.0_wp - q1(8,2) = 0.0_wp - q1(9,2) = 0.0_wp - q1(1,3) = 0.1510193840162481602541749755506215314879_wp - q1(2,3) = -0.9553948881729209047544587102401343033294_wp - q1(3,3) = 0.5046108447067502766506824050165990409443_wp - q1(4,3) = 0.2083429547547929960329552908847933822643_wp - q1(5,3) = 0.1359641889806059957290021663880456685165_wp - q1(6,3) = -0.04454248428547652391235612759992531988360_wp - q1(7,3) = 0.0_wp - q1(8,3) = 0.0_wp - q1(9,3) = 0.0_wp - q1(1,4) = 0.1012044551031772450693035010120167087525_wp - q1(2,4) = -0.2092303756284921666519857323651163414844_wp - q1(3,4) = -0.5084563818511371174184254139930350549204_wp - q1(4,4) = 0.2687068482925919014741556260496361261429_wp - q1(5,4) = 0.3188546759663099905683904142802147346506_wp - q1(6,4) = 0.02892077811755014695856160501628382685880_wp - q1(7,4) = 0.0_wp - q1(8,4) = 0.0_wp - q1(9,4) = 0.0_wp - q1(1,5) = -0.03614399304268576976452921364705641609825_wp - q1(2,5) = 0.08686979490791345456798112347556020198327_wp - q1(3,5) = 0.1257842030401363832877174373294422223313_wp - q1(4,5) = -0.9822882337192980168734300444655759205262_wp - q1(5,5) = 0.3656214294782277516821124793703186492319_wp - q1(6,5) = 0.4950000137574403598524650898428590604628_wp - q1(7,5) = -0.05484321442173416275231687190554779738479_wp - q1(8,5) = 0.0_wp - q1(9,5) = 0.0_wp - q1(1,6) = -0.01141318406360863692889821914555232596651_wp - q1(2,6) = 0.02049729840293952857599941220163960606616_wp - q1(3,6) = -0.005307030684704263298464084855734448481896_wp - q1(4,6) = 0.1618715440442110368368458160128159110211_wp - q1(5,6) = -0.9382337284956231267046263227657132050941_wp - q1(6,6) = 0.3287596173603342389443163398095933882788_wp - q1(7,6) = 0.4931394260405013584164745097143900824182_wp - q1(8,6) = -0.04931394260405013584164745097143900824182_wp - q1(9,6) = 0.0_wp - - a2(-3) = 0.0_wp - a2(-2) = 0.05000000000000000000000000000000000000000_wp - a2(-1) = -0.5000000000000000000000000000000000000000_wp - a2(0) = -0.3333333333333333333333333333333333333333_wp - a2(1) = 1.000000000000000000000000000000000000000_wp - a2(2) = -0.2500000000000000000000000000000000000000_wp - a2(3) = 0.03333333333333333333333333333333333333333_wp - - q2(1,1) = -1.635284636237086966078100959777273060297_wp - q2(2,1) = 2.191680138362037895776687246694092663418_wp - q2(3,1) = -0.2999586417085858029519146887814015472662_wp - q2(4,1) = -0.3973585426756003050233698160476207357348_wp - q2(5,1) = 0.1042956382142412661862395105494407610836_wp - q2(6,1) = 0.03662604404499391209045870736276191879693_wp - q2(7,1) = 0.0_wp - q2(8,1) = 0.0_wp - q2(9,1) = 0.0_wp - q2(1,2) = -0.4261090852993166609415800254745304380753_wp - q2(2,2) = -0.1198701406809289935902771997003246482977_wp - q2(3,2) = 0.4312121105197350491616311601533345702699_wp - q2(4,2) = 0.1866753655195354234725699724872485597294_wp - q2(5,2) = -0.05696107337797671536102449926055004670126_wp - q2(6,2) = -0.01494717668104810274131940820517799692506_wp - q2(7,2) = 0.0_wp - q2(8,2) = 0.0_wp - q2(9,2) = 0.0_wp - q2(1,3) = -0.008331409049041400793408941823041323547141_wp - q2(2,3) = -0.3179917159117626605641230407454828831892_wp - q2(3,3) = -0.5046108447067502766506824050165990409443_wp - q2(4,3) = 1.005096920081240801270874877753107657440_wp - q2(5,3) = -0.1827373971499731263661656683592800415536_wp - q2(6,3) = 0.008574446736286663103505178191295631794744_wp - q2(7,3) = 0.0_wp - q2(8,3) = 0.0_wp - q2(9,3) = 0.0_wp - q2(1,4) = 0.1280751399324364352167190636169803213668_wp - q2(2,4) = -0.3704544846040473075364791079948980171701_wp - q2(3,4) = -0.1053961094122492652071919749185808657060_wp - q2(4,4) = -0.2687068482925919014741556260496361261429_wp - q2(5,4) = 0.7219149484051978427796238533546689238650_wp - q2(6,4) = -0.1323033308580049939259317706134978488270_wp - q2(7,4) = 0.02687068482925919014741556260496361261429_wp - q2(8,4) = 0.0_wp - q2(9,4) = 0.0_wp - q2(1,5) = -0.03614399304268576976452921364705641609825_wp - q2(2,5) = 0.1234319378557362297361923714125920669065_wp - q2(3,5) = -0.09358865464680026772155005029274896720786_wp - q2(4,5) = -0.4338560895019563893502613254100979466783_wp - q2(5,5) = -0.3656214294782277516821124793703186492319_wp - q2(6,5) = 1.043432157974781987375633808898337034311_wp - q2(7,5) = -0.2742160721086708137615843595277389869240_wp - q2(8,5) = 0.03656214294782277516821124793703186492319_wp - q2(9,5) = 0.0_wp - q2(1,6) = -0.01141318406360863692889821914555232596651_wp - q2(2,6) = 0.02049729840293952857599941220163960606616_wp - q2(3,6) = 0.02756893105132916059596754912522489034598_wp - q2(4,6) = -0.03538422637198950652974398787294012194614_wp - q2(5,6) = -0.4450943024551217682881518130513231226759_wp - q2(6,6) = -0.3287596173603342389443163398095933882788_wp - q2(7,6) = 0.9862788520810027168329490194287801648364_wp - q2(8,6) = -0.2465697130202506792082372548571950412091_wp - q2(9,6) = 0.03287596173603342389443163398095933882788_wp - + call coeffs_up_6_3_opt ( a1, q1, a2, q2 ) first = .false. end if diff --git a/src/Derivatives_6_5.F90 b/src/Derivatives_6_5.F90 index 1aaae62..81acac7 100644 --- a/src/Derivatives_6_5.F90 +++ b/src/Derivatives_6_5.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_6_5 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,77 +28,7 @@ subroutine deriv_gf_6_5 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp - - q(1,1) = -137.0_wp/60.0_wp; q(2,1) = 5.0_wp; q(3,1) = -5.0_wp; - q(4,1) = 10.0_wp/3.0_wp; q(5,1) = -5.0_wp/4.0_wp; q(6,1) = 1.0_wp/5.0_wp; - q(7,1) = zero; q(8,1) = zero; q(9,1) = zero; q(10,1) = zero; - - q(1,2) = -0.3209098489859668118347_wp - q(2,2) = -0.359441670715467075894_wp - q(3,2) = 0.195756852998105503889_wp - q(4,2) = 1.394685510250317033169_wp - q(5,2) = -1.448965775497476572821_wp - q(6,2) = 0.6519476244467816674835_wp - q(7,2) = -0.1115052611983591304249_wp - q(8,2) = -0.00156743129793461356831_wp - q(9,2) = zero; q(10,2) = zero - - q(1,3) = 0.0980796259621024870281_wp - q(2,3) = -0.784752101846956387607_wp - q(3,3) = 0.364206221878666751300_wp - q(4,3) = 0.102097753636344358379_wp - q(5,3) = 0.377167650934576412896_wp - q(6,3) = -0.173241400242683302020_wp - q(7,3) = 0.0062120424243610783650_wp - q(8,3) = 0.01153111791917461507898_wp - q(9,3) = -0.00130091066558601341956_wp - q(10,3) = zero - - q(1,4) = 0.0771947815148234674634_wp - q(2,4) = -0.4124719432622107102831_wp - q(3,4) = 0.654798717867622763906_wp - q(4,4) = -1.873474657556531216053_wp - q(5,4) = 2.161961221935152129759_wp - q(6,4) = -0.729147814207596325277_wp - q(7,4) = 0.1292509053479867634674_wp - q(8,4) = -0.01092898521375837831427_wp - q(9,4) = 0.00316983426828354261009_wp - q(10,4) = -0.000352060693772037278516_wp - - q(1,5) = -0.01135836398682271847110_wp - q(2,5) = 0.0114974985688122284189_wp - q(3,5) = 0.228765565489867047381_wp - q(4,5) = -1.179122428698534075609_wp - q(5,5) = 0.774618306056840861215_wp - q(6,5) = 0.016612403904600041087_wp - q(7,5) = 0.2399304273448163041220_wp - q(8,5) = -0.0959180672407791626759_wp - q(9,5) = 0.01612460763754670343830_wp - q(10,5) = -0.001149949076347228906108_wp - - q(1,6) = -0.01912046962023373131259_wp - q(2,6) = 0.1569245474161812198493_wp - q(3,6) = -0.567250839387340928718_wp - q(4,6) = 1.230411310316952671353_wp - q(5,6) = -2.048795717924254691221_wp - q(6,6) = 0.982715833107347313532_wp - q(7,6) = 0.2876584784911885215053_wp - q(8,6) = -0.0207657038198929292487_wp - q(9,6) = -0.00335290957957120811713_wp - q(10,6) = 0.001575470999623762377395_wp - - q(1,7) = -0.0076072322555736921424_wp - q(2,7) = 0.034503414345314189270_wp - q(3,7) = -0.044377233426986476366_wp - q(4,7) = -0.049408595803628143797_wp - q(5,7) = 0.304693537653175477283_wp - q(6,7) = -0.935863321236636595622_wp - q(7,7) = 0.111375967229143365899_wp - q(8,7) = 0.7149322477536284813995_wp - q(9,7) = -0.1444768161656941519630_wp - q(10,7) = 0.01622803190725754603783_wp - + call coeffs_1_6_5 ( a, q ) first = .false. end if diff --git a/src/Derivatives_6_5_min_err_coeff.F90 b/src/Derivatives_6_5_min_err_coeff.F90 index f3735ab..7f9e209 100644 --- a/src/Derivatives_6_5_min_err_coeff.F90 +++ b/src/Derivatives_6_5_min_err_coeff.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_6_5_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -28,79 +28,7 @@ subroutine deriv_gf_6_5_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 3.0_wp/4.0_wp; a(2) = -3.0_wp/20.0_wp; a(3) = 1.0_wp/60.0_wp - - q(1,1) = -2.465354921110524023660777656111276003457_wp - q(2,1) = 6.092129526663144141964665936667656020742_wp - q(3,1) = -7.730323816657860354911664841669140051855_wp - q(4,1) = 6.973765088877147139882219788892186735807_wp - q(5,1) = -3.980323816657860354911664841669140051855_wp - q(6,1) = 1.292129526663144141964665936667656020742_wp - q(7,1) = -0.1820215877771906903274443227779426701237_wp - q(8,1) = 0.0_wp - q(9,1) = 0.0_wp - q(10,1) = 0.0_wp - q(1,2) = -0.2234725650784319828746535134412736890421_wp - q(2,2) = -0.9329308121107134563129925525068570679651_wp - q(3,2) = 1.586820596545839371759081303802027231274_wp - q(4,2) = -0.3647002340377160216914505558624668821400_wp - q(5,2) = -0.2666957784872806143914117440166232718819_wp - q(6,2) = 0.3112949048634705032101261273629794071371_wp - q(7,2) = -0.1404504214762266650000768489896480092493_wp - q(8,2) = 0.03488568514730479833596013512958238764128_wp - q(9,2) = -0.004964021886392518344179263072091597647654_wp - q(10,2) = 0.0002126465201465853095969115943714918742904_wp - q(1,3) = 0.1582216737061633151406179477554921935333_wp - q(2,3) = -1.137049298003377811733609086574457439398_wp - q(3,3) = 1.212364522932578587741649981040340946798_wp - q(4,3) = -0.9562288729513894906148167047868730813830_wp - q(5,3) = 1.066548057336766350478498057851678826640_wp - q(6,3) = -0.3478788551267041838265477441805600110467_wp - q(7,3) = -0.03133923293520187620333693909408071632123_wp - q(8,3) = 0.04098845955755862691072597869183962277781_wp - q(9,3) = -0.005963188634687155197078928402509551508436_wp - q(10,3) = 0.0003367341182936373038974376991292099082999_wp - q(1,4) = 0.02915734641890708196910927068736798144670_wp - q(2,4) = -0.1169665089768926152768236581512624861308_wp - q(3,4) = -0.1112219092451476301503253995474190870412_wp - q(4,4) = -0.7924486261248032107393766820001361351677_wp - q(5,4) = 1.266650704820613624987450232358951199911_wp - q(6,4) = -0.2899273290506621673153239836530375587273_wp - q(7,4) = 0.002515684257201926199329020583484434062150_wp - q(8,4) = 0.01329713961871764653006682056620518602804_wp - q(9,4) = -0.001124464399630667352932212208930962568134_wp - q(10,4) = 0.00006796268169601114882659136477742818715059_wp - q(1,5) = -0.04582150000326981674750984653096293434777_wp - q(2,5) = 0.2240986548857151482718685516611524323427_wp - q(3,5) = -0.3246718493011818141660859125588209338018_wp - q(4,5) = -0.3929792921782506986152017485694441380503_wp - q(5,5) = 0.1166355818729375628072830916953646214341_wp - q(6,5) = 0.3449626905957060254933930895775644438105_wp - q(7,5) = 0.1430419813354607083034935179267283951745_wp - q(8,5) = -0.07764802499372607792980458731991885121073_wp - q(9,5) = 0.01332439335504217034559288889042994978834_wp - q(10,5) = -0.0009426355684332077630290447720929851395193_wp - q(1,6) = 0.003172814452954821196677290327889903944225_wp - q(2,6) = 0.00001061446045061551877105554145609103530766_wp - q(3,6) = -0.08747763580209736614983637747947172321794_wp - q(4,6) = 0.3975827322299876034907453299884380895682_wp - q(5,6) = -1.148835072393422871630425744497391344782_wp - q(6,6) = 0.3583006649535242306065761818925080902380_wp - q(7,6) = 0.5647665154270147564019144982190032455071_wp - q(8,6) = -0.09698196887272109736153117076061707705561_wp - q(9,6) = 0.008843905091972988427261446924164441884143_wp - q(10,6) = 0.0006174304523363194998474898440202828786385_wp - q(1,7) = -0.008639107540858839028043929986084287776394_wp - q(2,7) = 0.04722773954485212324714352753530343274219_wp - q(3,7) = -0.1008747537650261142294540111407681552350_wp - q(4,7) = 0.08043834953845218736895768965086958762389_wp - q(5,7) = 0.1295138674713300902982857323205417604553_wp - q(6,7) = -0.7909424166489541737614153656634872155367_wp - q(7,7) = 0.03807866847647628589685997987877954466259_wp - q(8,7) = 0.7367055699548196242687865288427927434250_wp - q(9,7) = -0.1480235854665196220062411065981933720158_wp - q(10,7) = 0.01651566843542843794512095516024596165494_wp - + call coeffs_1_6_5_opt ( a, q ) first = .false. end if diff --git a/src/Derivatives_8_4.F90 b/src/Derivatives_8_4.F90 index 025ae27..9b74e48 100644 --- a/src/Derivatives_8_4.F90 +++ b/src/Derivatives_8_4.F90 @@ -4,13 +4,13 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -21,7 +21,6 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) CCTK_REAL, dimension(4), save :: a CCTK_REAL, dimension(12,8), save :: q - CCTK_REAL, parameter :: x1 = 0.541_wp, x2 = -0.0675_wp, x3 = 0.748_wp CCTK_REAL :: idel CCTK_INT :: il, ir, jl, jr, kl, kr @@ -29,139 +28,7 @@ subroutine deriv_gf_8_4 ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) logical, save :: first = .true. if ( first ) then - a(1) = 4.0_wp/5.0_wp; a(2) = -1.0_wp/5.0_wp - a(3) = 4.0_wp/105.0_wp; a(4) = -1.0_wp/280.0_wp - - q(1,1) = -2540160.0_wp/1498139.0_wp - q(2,1) = 9.0_wp * ( 2257920.0_wp*x1 + 11289600.0_wp*x2 + & - 22579200.0_wp*x3 - 15849163.0_wp ) / 5992556.0_wp - q(3,1) = 3.0_wp * ( -33868800.0_wp*x1 - 162570240.0_wp*x2 - & - 304819200.0_wp*x3 + 235236677.0_wp ) / 5992556.0_wp - q(4,1) = ( 609638400.0_wp*x1 + 2743372800.0_wp*x2 + & - 4572288000.0_wp * x3 - 3577778591.0_wp ) / 17977668.0_wp - q(5,1) = 3.0_wp * ( -16934400*x1 - 67737600.0_wp*x2 - & - 84672000.0_wp*x3 + 67906303.0_wp ) / 1498139.0_wp - q(6,1) = 105.0_wp * ( 967680.0_wp*x1 + 2903040.0_wp*x2 - & - 305821.0_wp ) / 5992556.0_wp - q(7,1) = 49.0_wp * ( -1244160.0_wp*x1 + 18662400.0_wp * x3 - & - 13322233.0_wp ) / 17977668.0_wp - q(8,1) = 3.0_wp * ( -6773760.0_wp*x2 - 33868800.0_wp*x3 + & - 24839327.0_wp ) / 5992556.0_wp - q(9,1) = zero; q(10,1) = zero; q(11,1) = zero; q(12,1) = zero - - q(1,2) = 9.0_wp * ( -2257920.0_wp*x1 - 11289600.0_wp*x2 - & - 22579200.0_wp*x3 + 15849163.0_wp ) / 31004596.0_wp - q(2,2) = zero - q(3,2) = 3.0_wp * ( 7257600.0_wp*x1 + 33868800.0_wp*x2 + & - 60963840.0_wp*x3 - 47167457.0_wp ) / 2214614.0_wp - q(4,2) = 3.0_wp * ( -9676800.0_wp*x1 - 42336000.0_wp*x2 - & - 67737600.0_wp*x3 + 53224573.0_wp ) / 1107307.0_wp - q(5,2) = 7.0_wp * ( 55987200.0_wp*x1 + 217728000.0_wp*x2 + & - 261273600.0_wp*x3 - 211102099.0_wp ) / 13287684.0_wp - q(6,2) = 3.0_wp * ( -11612160.0_wp*x1 - 33868800.0_wp*x2 + & - 3884117.0_wp ) / 2214614.0_wp - q(7,2) = 150.0_wp * ( 24192.0_wp*x1 - 338688.0_wp*x3 + & - 240463.0_wp ) / 1107307.0_wp - q(8,2) = ( 152409600.0_wp*x2 + 731566080.0_wp*x3 - & - 536324953.0_wp ) / 46506894.0_wp - q(9,2) = zero; q(10,2) = zero; q(11,2) = zero; q(12,2) = zero - - q(1,3) = ( 33868800.0_wp*x1 + 162570240.0_wp*x2 + & - 304819200.0_wp*x3 - 235236677.0_wp ) / 1743924.0_wp - q(2,3) = ( -7257600.0_wp*x1 - 33868800.0_wp*x2 - & - 60963840.0_wp*x3 + 47167457.0_wp ) / 124566.0_wp - q(3,3) = zero - q(4,3) = ( 24192000.0_wp*x1 + 101606400.0_wp*x2 + & - 152409600.0_wp*x3 - 120219461.0_wp ) / 124566.0_wp - q(5,3) = ( -72576000.0_wp*x1 - 270950400.0_wp*x2 - & - 304819200.0_wp*x3 + 249289259.0_wp ) / 249132.0_wp - q(6,3) = 9.0_wp * ( 806400.0_wp*x1 + 2257920.0_wp*x2 - & - 290167.0_wp ) / 41522.0_wp - q(7,3) = 6.0_wp * ( -134400.0_wp*x1 + 1693440.0_wp*x3 - & - 1191611.0_wp ) / 20761.0_wp - q(8,3) = 5.0_wp * ( -2257920.0_wp*x2 - 10160640.0_wp*x3 + & - 7439833.0_wp ) / 290654.0_wp - q(9,3) = zero; q(10,3) = zero; q(11,3) = zero; q(12,3) = zero - - q(1,4) = ( -609638400.0_wp*x1 - 2743372800.0_wp*x2 - & - 4572288000.0_wp*x3 + 3577778591.0_wp ) / 109619916.0_wp - q(2,4) = 3.0_wp * ( 9676800.0_wp*x1 + 42336000.0_wp*x2 + & - 67737600.0_wp*x3 - 53224573.0_wp ) / 1304999.0_wp - q(3,4) = 3.0_wp * ( -24192000.0_wp*x1 - 101606400.0_wp*x2 - & - 152409600.0_wp*x3 + 120219461.0_wp ) / 2609998.0_wp - q(4,4) = zero - q(5,4) = 9.0_wp * ( 16128000.0_wp*x1 + 56448000.0_wp*x2 + & - 56448000.0_wp*x3 - 47206049.0_wp ) / 5219996.0_wp - q(6,4) = 3.0_wp * ( -19353600.0_wp*x1 - 50803200.0_wp*x2 + & - 7628371.0_wp ) / 2609998.0_wp - q(7,4) = 2.0_wp * ( 10886400.0_wp*x1 - 114307200.0_wp*x3 + & - 79048289.0_wp ) / 3914997.0_wp - q(8,4) = 75.0_wp * ( 1354752.0_wp*x2 + 5419008.0_wp*x3 - & - 3952831.0_wp ) / 18269986.0_wp - q(9,4) = zero; q(10,4) = zero; q(11,4) = zero; q(12,4) = zero - - q(1,5) = 3.0_wp * ( 16934400.0_wp*x1 + 67737600.0_wp*x2 + & - 84672000.0_wp*x3 - 67906303.0_wp ) / 2096689.0_wp - q(2,5) = 7.0_wp * ( -55987200.0_wp*x1 - 217728000.0_wp*x2 - & - 261273600.0_wp*x3 + 211102099.0_wp ) / 3594324.0_wp - q(3,5) = 3.0_wp * ( 72576000.0_wp*x1 + 270950400.0_wp*x2 + & - 304819200.0_wp*x3 - 249289259.0_wp ) / 1198108.0_wp - q(4,5) = 9.0_wp * ( -16128000.0_wp*x1 - 56448000.0_wp*x2 - & - 56448000.0_wp*x3 + 47206049.0_wp ) / 1198108.0_wp - q(5,5) = zero - q(6,5) = 105.0_wp * ( 414720.0_wp*x1 + 967680.0_wp*x2 - & - 165527.0_wp ) / 1198108.0_wp - q(7,5) = 15.0_wp * ( -967680.0_wp*x1 + 6773760.0_wp*x3 - & - 4472029.0_wp ) / 1198108.0_wp - q(8,5) = ( -304819200.0_wp*x2 - 914457600.0_wp*x3 + & - 657798011.0_wp ) / 25160268.0_wp - q(9,5) = -2592.0_wp/299527.0_wp; - q(10,5) = zero; q(11,5) = zero; q(12,5) = zero - - q(1,6) = 5.0_wp * ( -967680.0_wp*x1 - 2903040.0_wp*x2 + & - 305821.0_wp ) / 1237164.0_wp - q(2,6) = ( 11612160.0_wp*x1 + 33868800.0_wp*x2 - & - 3884117.0_wp ) / 618582.0_wp - q(3,6) = 9.0_wp * ( -806400.0_wp*x1 - 2257920.0_wp*x2 + & - 290167.0_wp ) / 206194.0_wp - q(4,6) = ( 19353600.0_wp*x1 + 50803200.0_wp*x2 - & - 7628371.0_wp ) / 618582.0_wp - q(5,6) = 35.0_wp * ( -414720.0_wp*x1 - 967680.0_wp*x2 + & - 165527.0_wp ) / 1237164.0_wp - q(6,6) = zero; q(7,6) = 80640.0_wp*x1 / 103097.0_wp - q(8,6) = 80640.0_wp*x2 / 103097.0_wp; q(9,6) = 3072.0_wp / 103097.0_wp - q(10,6) = -288.0_wp/103097.0_wp; q(11,6) = zero; q(12,6) = zero - - q(1,7) = 7.0_wp * ( 1244160.0_wp*x1 - 18662400.0_wp*x3 + & - 13322233.0_wp ) / 8041092.0_wp - q(2,7) = 150.0_wp * ( -24192.0_wp*x1 + 338688.0_wp*x3 - & - 240463.0_wp ) / 670091.0_wp - q(3,7) = 54.0_wp * ( 134400.0_wp*x1 - 1693440.0_wp*x3 + & - 1191611.0_wp ) / 670091.0_wp - q(4,7) = 2.0_wp * ( -10886400.0_wp*x1 + 114307200.0_wp*x3 - & - 79048289.0_wp ) / 2010273.0_wp - q(5,7) = 15.0_wp * ( 967680.0_wp*x1 - 6773760.0_wp*x3 + & - 4472029.0_wp ) / 2680364.0_wp - q(6,7) = -725760.0_wp*x1 / 670091.0_wp; q(7,7) = zero - q(8,7) = 725760.0_wp*x3 / 670091.0_wp; q(9,7) = -145152.0_wp/670091.0_wp - q(10,7) = 27648.0_wp/670091.0_wp; q(11,7) = -2592.0_wp/670091.0_wp - q(12,7) = zero - - q(1,8) = 3.0_wp * ( 6773760.0_wp*x2 + 33868800.0_wp*x3 - & - 24839327.0_wp ) / 20510956.0_wp - q(2,8) = ( -152409600.0_wp*x2 - 731566080.0_wp*x3 + & - 536324953.0_wp ) / 30766434.0_wp - q(3,8) = 45.0_wp * ( 2257920.0_wp*x2 + 10160640.0_wp*x3 - & - 7439833.0_wp ) / 10255478.0_wp - q(4,8) = 75.0_wp * ( -1354752.0_wp*x2 - 5419008.0_wp*x3 + & - 3952831.0_wp ) / 10255478.0_wp - q(5,8) = ( 304819200.0_wp*x2 + 914457600.0_wp*x3 - & - 657798011.0_wp ) / 61532868.0_wp - q(6,8) = -5080320.0_wp*x2 / 5127739.0_wp - q(7,8) = -5080320.0_wp*x3 / 5127739.0_wp; q(8,8) = zero - q(9,8) = 4064256.0_wp/5127739.0_wp; q(10,8) = -1016064.0_wp/5127739.0_wp - q(11,8) = 193536.0_wp/5127739.0_wp; q(12,8) = -18144.0_wp/5127739.0_wp - + call coeffs_1_8_4 ( a, q ) first = .false. end if diff --git a/src/Derivatives_8_4_min_err_coeff.F90 b/src/Derivatives_8_4_min_err_coeff.F90 index 944e177..af9b15f 100644 --- a/src/Derivatives_8_4_min_err_coeff.F90 +++ b/src/Derivatives_8_4_min_err_coeff.F90 @@ -2,20 +2,21 @@ #include "cctk_Functions.h" #include "cctk_Parameters.h" -subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) +subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, offset, delta, dvar ) + + use All_Coeffs_mod implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir CCTK_INT, intent(IN) :: bb(2) CCTK_INT, intent(IN) :: gsize + CCTK_INT, intent(IN) :: offset(2) CCTK_REAL, intent(IN) :: delta CCTK_REAL, dimension(ni,nj,nk), intent(OUT) :: dvar @@ -23,111 +24,12 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) CCTK_REAL, dimension(12,8), save :: q CCTK_REAL :: idel - CCTK_INT :: il, ir, jl, jr, kl, kr + CCTK_INT :: il, ir, jl, jr, kl, kr, ol, or logical, save :: first = .true. if ( first ) then - a(1) = 4.0_wp/5.0_wp; a(2) = -1.0_wp/5.0_wp - a(3) = 4.0_wp/105.0_wp; a(4) = -1.0_wp/280.0_wp - - q(1,1) = -1.695543604431898508749855654248370812054_wp - q(2,1) = 2.244525109969933844775276252674718713114_wp - q(3,1) = -0.002163206607021876385102025416828692597556_wp - q(4,1) = -0.8963677947307838167920190976769921451579_wp - q(5,1) = 0.2272938673777916084251861567415263328923_wp - q(6,1) = 0.1564962758424078514454013191006671546757_wp - q(7,1) = 0.003067629343740613524557473056482141287158_wp - q(8,1) = -0.03730827676416971624344442423120269215938_wp - q(9,1) = 0.0_wp - q(10,1) = 0.0_wp - q(11,1) = 0.0_wp - q(12,1) = 0.0_wp - q(1,2) = -0.4338209217401506177055540526837828066711_wp - q(2,2) = 0.0_wp - q(3,2) = 0.06631961192627293470305188523936353462439_wp - q(4,2) = 0.6021342012739069461791324177355805603656_wp - q(5,2) = -0.2213339967864188453859900127368926875520_wp - q(6,2) = -0.001759980003751516130708214237001705688807_wp - q(7,2) = -0.03586646217917856587352426166797879385310_wp - q(8,2) = 0.02432754750931966421359223835071189877503_wp - q(9,2) = 0.0_wp - q(10,2) = 0.0_wp - q(11,2) = 0.0_wp - q(12,2) = 0.0_wp - q(1,3) = 0.002477771724790106958560398469919805908522_wp - q(2,3) = -0.3930241559935857537756812928554282732813_wp - q(3,3) = 0.0_wp - q(4,3) = -0.6080263371305341035810612202824357742461_wp - q(5,3) = 2.372533124692864412954923458457782022478_wp - q(6,3) = -2.126112217612194556872952028715623246817_wp - q(7,3) = 0.9075309435559160631495435310307745215131_wp - q(8,3) = -0.1553791292372561688333328461049890555549_wp - q(9,3) = 0.0_wp - q(10,3) = 0.0_wp - q(11,3) = 0.0_wp - q(12,3) = 0.0_wp - q(1,4) = 0.1470043328582935680963279007411074464266_wp - q(2,4) = -0.5109179516689331400658365102850902594996_wp - q(3,4) = 0.08705685833207777685654755900085198684605_wp - q(4,4) = 0.0_wp - q(5,4) = -0.1306945333157231839535552435788086367322_wp - q(6,4) = 0.5981933016362239542598518794410035592720_wp - q(7,4) = -0.2031099149801233772210520666270517105660_wp - q(8,4) = 0.01246790713818440202771648130798761425319_wp - q(9,4) = 0.0_wp - q(10,4) = 0.0_wp - q(11,4) = 0.0_wp - q(12,4) = 0.0_wp - q(1,5) = -0.1624073990846984662267508265053107632238_wp - q(2,5) = 0.8182390368133059538132603839842499379861_wp - q(3,5) = -1.480018301574606037840376638130713134769_wp - q(4,5) = 0.5694185675497882973361521309100738568707_wp - q(5,5) = 0.0_wp - q(6,5) = 0.02929508293831017534661096502884570435894_wp - q(7,5) = 0.2825910005984090924748504462528740123097_wp - q(8,5) = -0.04846434332860791750685068920563907354793_wp - q(9,5) = -0.008653643911901097396895772334380539984709_wp - q(10,5) = 0.0_wp - q(11,5) = 0.0_wp - q(12,5) = 0.0_wp - q(1,6) = -0.03609686950604370828405582087760384548297_wp - q(2,6) = 0.002100328577309696555612805397001149641337_wp - q(3,6) = 0.4281425817419204360479874008765051769418_wp - q(4,6) = -0.8413238238875046736839550701643761633826_wp - q(5,6) = -0.009456755727630000971085851751473603919416_wp - q(6,6) = 0.0_wp - q(7,6) = 0.5172389789041733771234394082779034212042_wp - q(8,6) = -0.08760813565107717873901807278223424202774_wp - q(9,6) = 0.02979718129528502284256573906127239395909_wp - q(10,6) = -0.002793485746432970891490538036994286933664_wp - q(11,6) = 0.0_wp - q(12,6) = 0.0_wp - q(1,7) = -0.0009797678134978722516935350416937185004514_wp - q(2,7) = 0.05926834509975463070197111976550139351983_wp - q(3,7) = -0.2530570463899371286637621744353665227114_wp - q(4,7) = 0.3955555826583941989223787901885502942688_wp - q(5,7) = -0.1263166266018192756531792392597193430222_wp - q(6,7) = -0.7162192643577544899896537844517283192029_wp - q(7,7) = 0.0_wp - q(8,7) = 0.8209721963136350137518635528607308559584_wp - q(9,7) = -0.2166153552278720352907291696202456084323_wp - q(10,7) = 0.04126006766245181624585317516576106827282_wp - q(11,7) = -0.003868131343354857773048735171790100150577_wp - q(12,7) = 0.0_wp - q(1,8) = 0.01090012273307913185972171872891927027272_wp - q(2,8) = -0.03677379943661633440187210478144113487019_wp - q(3,8) = 0.03963287609450569641558898819403594845401_wp - q(4,8) = -0.02221139656912423686782339404035534965598_wp - q(5,8) = 0.01981665906734246925389947980969432794418_wp - q(6,8) = 0.1109698768905366566973791789571759073485_wp - q(7,8) = -0.7509903604688148129224205834189298636300_wp - q(8,8) = 0.0_wp - q(9,8) = 0.7926019635554773751160111698352821779736_wp - q(10,8) = -0.1981504908888693437790027924588205444934_wp - q(11,8) = 0.03774295064549892262457196046834677037969_wp - q(12,8) = -0.003538401623015523996053621293907509723096_wp - + call set_coeff_8_4_opt ( a, q ) first = .false. end if @@ -137,91 +39,92 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) direction: select case (dir) case (0) direction + ol = offset(1); or = offset(2) if ( bb(1) == 0 ) then il = 1 + gsize else - dvar(1,:,:) = ( q(1,1) * var(1,:,:) + q(2,1) * var(2,:,:) + & - q(3,1) * var(3,:,:) + q(4,1) * var(4,:,:) + & - q(5,1) * var(5,:,:) + q(6,1) * var(6,:,:) + & - q(7,1) * var(7,:,:) + q(8,1) * var(8,:,:) ) * idel - dvar(2,:,:) = ( q(1,2) * var(1,:,:) + q(3,2) * var(3,:,:) + & - q(4,2) * var(4,:,:) + q(5,2) * var(5,:,:) + & - q(6,2) * var(6,:,:) + q(7,2) * var(7,:,:) + & - q(8,2) * var(8,:,:) ) * idel - dvar(3,:,:) = ( q(1,3) * var(1,:,:) + q(2,3) * var(2,:,:) + & - q(4,3) * var(4,:,:) + q(5,3) * var(5,:,:) + & - q(6,3) * var(6,:,:) + q(7,3) * var(7,:,:) + & - q(8,3) * var(8,:,:) ) * idel - dvar(4,:,:) = ( q(1,4) * var(1,:,:) + q(2,4) * var(2,:,:) + & - q(3,4) * var(3,:,:) + q(5,4) * var(5,:,:) + & - q(6,4) * var(6,:,:) + q(7,4) * var(7,:,:) + & - q(8,4) * var(8,:,:) ) * idel - dvar(5,:,:) = ( q(1,5) * var(1,:,:) + q(2,5) * var(2,:,:) + & - q(3,5) * var(3,:,:) + q(4,5) * var(4,:,:) + & - q(6,5) * var(6,:,:) + q(7,5) * var(7,:,:) + & - q(8,5) * var(8,:,:) + q(9,5) * var(9,:,:) ) * idel - dvar(6,:,:) = ( q(1,6) * var(1,:,:) + q(2,6) * var(2,:,:) + & - q(3,6) * var(3,:,:) + q(4,6) * var(4,:,:) + & - q(5,6) * var(5,:,:) + q(7,6) * var(7,:,:) + & - q(8,6) * var(8,:,:) + q(9,6) * var(9,:,:) + & - q(10,6) * var(10,:,:) ) * idel - dvar(7,:,:) = ( q(1,7) * var(1,:,:) + q(2,7) * var(2,:,:) + & - q(3,7) * var(3,:,:) + q(4,7) * var(4,:,:) + & - q(5,7) * var(5,:,:) + q(6,7) * var(6,:,:) + & - q(8,7) * var(8,:,:) + q(9,7) * var(9,:,:) + & - q(10,7) * var(10,:,:) + q(11,7) * var(11,:,:) ) * idel - dvar(8,:,:) = ( q(1,8) * var(1,:,:) + q(2,8) * var(2,:,:) + & - q(3,8) * var(3,:,:) + q(4,8) * var(4,:,:) + & - q(5,8) * var(5,:,:) + q(6,8) * var(6,:,:) + & - q(7,8) * var(7,:,:) + q(9,8) * var(9,:,:) + & - q(10,8) * var(10,:,:) + q(11,8) * var(11,:,:) + & - q(12,8) * var(12,:,:) ) * idel - il = 9 + dvar(1+ol,:,:) = ( q(1,1) * var(1+ol,:,:) + q(2,1) * var(2+ol,:,:) + & + q(3,1) * var(3+ol,:,:) + q(4,1) * var(4+ol,:,:) + & + q(5,1) * var(5+ol,:,:) + q(6,1) * var(6+ol,:,:) + & + q(7,1) * var(7+ol,:,:) + q(8,1) * var(8+ol,:,:) ) * idel + dvar(2+ol,:,:) = ( q(1,2) * var(1+ol,:,:) + q(3,2) * var(3+ol,:,:) + & + q(4,2) * var(4+ol,:,:) + q(5,2) * var(5+ol,:,:) + & + q(6,2) * var(6+ol,:,:) + q(7,2) * var(7+ol,:,:) + & + q(8,2) * var(8+ol,:,:) ) * idel + dvar(3+ol,:,:) = ( q(1,3) * var(1+ol,:,:) + q(2,3) * var(2+ol,:,:) + & + q(4,3) * var(4+ol,:,:) + q(5,3) * var(5+ol,:,:) + & + q(6,3) * var(6+ol,:,:) + q(7,3) * var(7+ol,:,:) + & + q(8,3) * var(8+ol,:,:) ) * idel + dvar(4+ol,:,:) = ( q(1,4) * var(1+ol,:,:) + q(2,4) * var(2+ol,:,:) + & + q(3,4) * var(3+ol,:,:) + q(5,4) * var(5+ol,:,:) + & + q(6,4) * var(6+ol,:,:) + q(7,4) * var(7+ol,:,:) + & + q(8,4) * var(8+ol,:,:) ) * idel + dvar(5+ol,:,:) = ( q(1,5) * var(1+ol,:,:) + q(2,5) * var(2+ol,:,:) + & + q(3,5) * var(3+ol,:,:) + q(4,5) * var(4+ol,:,:) + & + q(6,5) * var(6+ol,:,:) + q(7,5) * var(7+ol,:,:) + & + q(8,5) * var(8+ol,:,:) + q(9,5) * var(9+ol,:,:) ) * idel + dvar(6+ol,:,:) = ( q(1,6) * var(1+ol,:,:) + q(2,6) * var(2+ol,:,:) + & + q(3,6) * var(3+ol,:,:) + q(4,6) * var(4+ol,:,:) + & + q(5,6) * var(5+ol,:,:) + q(7,6) * var(7+ol,:,:) + & + q(8,6) * var(8+ol,:,:) + q(9,6) * var(9+ol,:,:) + & + q(10,6) * var(10+ol,:,:) ) * idel + dvar(7+ol,:,:) = ( q(1,7) * var(1+ol,:,:) + q(2,7) * var(2+ol,:,:) + & + q(3,7) * var(3+ol,:,:) + q(4,7) * var(4+ol,:,:) + & + q(5,7) * var(5+ol,:,:) + q(6,7) * var(6+ol,:,:) + & + q(8,7) * var(8+ol,:,:) + q(9,7) * var(9+ol,:,:) + & + q(10,7) * var(10+ol,:,:) + q(11,7) * var(11+ol,:,:) ) * idel + dvar(8+ol,:,:) = ( q(1,8) * var(1+ol,:,:) + q(2,8) * var(2+ol,:,:) + & + q(3,8) * var(3+ol,:,:) + q(4,8) * var(4+ol,:,:) + & + q(5,8) * var(5+ol,:,:) + q(6,8) * var(6+ol,:,:) + & + q(7,8) * var(7+ol,:,:) + q(9,8) * var(9+ol,:,:) + & + q(10,8) * var(10+ol,:,:) + q(11,8) * var(11+ol,:,:) + & + q(12,8) * var(12+ol,:,:) ) * idel + il = 9 + ol end if if ( bb(2) == 0 ) then ir = ni - gsize else - dvar(ni,:,:) = - ( q(1,1) * var(ni,:,:) + q(2,1) * var(ni-1,:,:) + & - q(3,1) * var(ni-2,:,:) + q(4,1) * var(ni-3,:,:) + & - q(5,1) * var(ni-4,:,:) + q(6,1) * var(ni-5,:,:) + & - q(7,1) * var(ni-6,:,:) + & - q(8,1) * var(ni-7,:,:) ) * idel - dvar(ni-1,:,:) = - ( q(1,2) * var(ni,:,:) + q(3,2) * var(ni-2,:,:) + & - q(4,2) * var(ni-3,:,:) + q(5,2) * var(ni-4,:,:) + & - q(6,2) * var(ni-5,:,:) + q(7,2) * var(ni-6,:,:) + & - q(8,2) * var(ni-7,:,:) ) * idel - dvar(ni-2,:,:) = - ( q(1,3) * var(ni,:,:) + q(2,3) * var(ni-1,:,:) + & - q(4,3) * var(ni-3,:,:) + q(5,3) * var(ni-4,:,:) + & - q(6,3) * var(ni-5,:,:) + q(7,3) * var(ni-6,:,:) + & - q(8,3) * var(ni-7,:,:) ) * idel - dvar(ni-3,:,:) = - ( q(1,4) * var(ni,:,:) + q(2,4) * var(ni-1,:,:) + & - q(3,4) * var(ni-2,:,:) + q(5,4) * var(ni-4,:,:) + & - q(6,4) * var(ni-5,:,:) + q(7,4) * var(ni-6,:,:) + & - q(8,4) * var(ni-7,:,:) ) * idel - dvar(ni-4,:,:) = - ( q(1,5) * var(ni,:,:) + q(2,5) * var(ni-1,:,:) + & - q(3,5) * var(ni-2,:,:) + q(4,5) * var(ni-3,:,:) + & - q(6,5) * var(ni-5,:,:) + q(7,5) * var(ni-6,:,:) + & - q(8,5) * var(ni-7,:,:) + & - q(9,5) * var(ni-8,:,:) ) * idel - dvar(ni-5,:,:) = - ( q(1,6) * var(ni,:,:) + q(2,6) * var(ni-1,:,:) + & - q(3,6) * var(ni-2,:,:) + q(4,6) * var(ni-3,:,:) + & - q(5,6) * var(ni-4,:,:) + q(7,6) * var(ni-6,:,:) + & - q(8,6) * var(ni-7,:,:) + q(9,6) * var(ni-8,:,:) + & - q(10,6) * var(ni-9,:,:) ) * idel - dvar(ni-6,:,:) = - ( q(1,7) * var(ni,:,:) + q(2,7) * var(ni-1,:,:) + & - q(3,7) * var(ni-2,:,:) + q(4,7) * var(ni-3,:,:) + & - q(5,7) * var(ni-4,:,:) + q(6,7) * var(ni-5,:,:) + & - q(8,7) * var(ni-7,:,:) + q(9,7) * var(ni-8,:,:) + & - q(10,7) * var(ni-9,:,:) + & - q(11,7) * var(ni-10,:,:) ) * idel - dvar(ni-7,:,:) = - ( q(1,8) * var(ni,:,:) + q(2,8) * var(ni-1,:,:) + & - q(3,8) * var(ni-2,:,:) + q(4,8) * var(ni-3,:,:) + & - q(5,8) * var(ni-4,:,:) + q(6,8) * var(ni-5,:,:) + & - q(7,8) * var(ni-6,:,:) + q(9,8) * var(ni-8,:,:) + & - q(10,8) * var(ni-9,:,:) + & - q(11,8) * var(ni-10,:,:) + & - q(12,8) * var(ni-11,:,:) ) * idel - ir = ni - 8 + dvar(ni-or,:,:) = - ( q(1,1) * var(ni-or,:,:) + q(2,1) * var(ni-1-or,:,:) + & + q(3,1) * var(ni-2-or,:,:) + q(4,1) * var(ni-3-or,:,:) + & + q(5,1) * var(ni-4-or,:,:) + q(6,1) * var(ni-5-or,:,:) + & + q(7,1) * var(ni-6-or,:,:) + & + q(8,1) * var(ni-7-or,:,:) ) * idel + dvar(ni-1-or,:,:) = - ( q(1,2) * var(ni-or,:,:) + q(3,2) * var(ni-2-or,:,:) + & + q(4,2) * var(ni-3-or,:,:) + q(5,2) * var(ni-4-or,:,:) + & + q(6,2) * var(ni-5-or,:,:) + q(7,2) * var(ni-6-or,:,:) + & + q(8,2) * var(ni-7-or,:,:) ) * idel + dvar(ni-2-or,:,:) = - ( q(1,3) * var(ni-or,:,:) + q(2,3) * var(ni-1-or,:,:) + & + q(4,3) * var(ni-3-or,:,:) + q(5,3) * var(ni-4-or,:,:) + & + q(6,3) * var(ni-5-or,:,:) + q(7,3) * var(ni-6-or,:,:) + & + q(8,3) * var(ni-7-or,:,:) ) * idel + dvar(ni-3-or,:,:) = - ( q(1,4) * var(ni-or,:,:) + q(2,4) * var(ni-1-or,:,:) + & + q(3,4) * var(ni-2-or,:,:) + q(5,4) * var(ni-4-or,:,:) + & + q(6,4) * var(ni-5-or,:,:) + q(7,4) * var(ni-6-or,:,:) + & + q(8,4) * var(ni-7-or,:,:) ) * idel + dvar(ni-4-or,:,:) = - ( q(1,5) * var(ni-or,:,:) + q(2,5) * var(ni-1-or,:,:) + & + q(3,5) * var(ni-2-or,:,:) + q(4,5) * var(ni-3-or,:,:) + & + q(6,5) * var(ni-5-or,:,:) + q(7,5) * var(ni-6-or,:,:) + & + q(8,5) * var(ni-7-or,:,:) + & + q(9,5) * var(ni-8-or,:,:) ) * idel + dvar(ni-5-or,:,:) = - ( q(1,6) * var(ni-or,:,:) + q(2,6) * var(ni-1-or,:,:) + & + q(3,6) * var(ni-2-or,:,:) + q(4,6) * var(ni-3-or,:,:) + & + q(5,6) * var(ni-4-or,:,:) + q(7,6) * var(ni-6-or,:,:) + & + q(8,6) * var(ni-7-or,:,:) + q(9,6) * var(ni-8-or,:,:) + & + q(10,6) * var(ni-9-or,:,:) ) * idel + dvar(ni-6-or,:,:) = - ( q(1,7) * var(ni-or,:,:) + q(2,7) * var(ni-1-or,:,:) + & + q(3,7) * var(ni-2-or,:,:) + q(4,7) * var(ni-3-or,:,:) + & + q(5,7) * var(ni-4-or,:,:) + q(6,7) * var(ni-5-or,:,:) + & + q(8,7) * var(ni-7-or,:,:) + q(9,7) * var(ni-8-or,:,:) + & + q(10,7) * var(ni-9-or,:,:) + & + q(11,7) * var(ni-10-or,:,:) ) * idel + dvar(ni-7-or,:,:) = - ( q(1,8) * var(ni-or,:,:) + q(2,8) * var(ni-1-or,:,:) + & + q(3,8) * var(ni-2-or,:,:) + q(4,8) * var(ni-3-or,:,:) + & + q(5,8) * var(ni-4-or,:,:) + q(6,8) * var(ni-5-or,:,:) + & + q(7,8) * var(ni-6-or,:,:) + q(9,8) * var(ni-8-or,:,:) + & + q(10,8) * var(ni-9-or,:,:) + & + q(11,8) * var(ni-10-or,:,:) + & + q(12,8) * var(ni-11-or,:,:) ) * idel + ir = ni - 8 - or end if if (il > ir+1) call CCTK_WARN (0, "domain too small") dvar(il:ir,:,:) = ( a(1) * ( var(il+1:ir+1,:,:) - & @@ -233,94 +136,95 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) a(4) * ( var(il+4:ir+4,:,:) - & var(il-4:ir-4,:,:) ) ) * idel case (1) direction + ol = offset(1); or = offset(2) if ( zero_derivs_y /= 0 ) then dvar = zero else if ( bb(1) == 0 ) then jl = 1 + gsize else - dvar(:,1,:) = ( q(1,1) * var(:,1,:) + q(2,1) * var(:,2,:) + & - q(3,1) * var(:,3,:) + q(4,1) * var(:,4,:) + & - q(5,1) * var(:,5,:) + q(6,1) * var(:,6,:) + & - q(7,1) * var(:,7,:) + q(8,1) * var(:,8,:) ) * idel - dvar(:,2,:) = ( q(1,2) * var(:,1,:) + q(3,2) * var(:,3,:) + & - q(4,2) * var(:,4,:) + q(5,2) * var(:,5,:) + & - q(6,2) * var(:,6,:) + q(7,2) * var(:,7,:) + & - q(8,2) * var(:,8,:) ) * idel - dvar(:,3,:) = ( q(1,3) * var(:,1,:) + q(2,3) * var(:,2,:) + & - q(4,3) * var(:,4,:) + q(5,3) * var(:,5,:) + & - q(6,3) * var(:,6,:) + q(7,3) * var(:,7,:) + & - q(8,3) * var(:,8,:) ) * idel - dvar(:,4,:) = ( q(1,4) * var(:,1,:) + q(2,4) * var(:,2,:) + & - q(3,4) * var(:,3,:) + q(5,4) * var(:,5,:) + & - q(6,4) * var(:,6,:) + q(7,4) * var(:,7,:) + & - q(8,4) * var(:,8,:) ) * idel - dvar(:,5,:) = ( q(1,5) * var(:,1,:) + q(2,5) * var(:,2,:) + & - q(3,5) * var(:,3,:) + q(4,5) * var(:,4,:) + & - q(6,5) * var(:,6,:) + q(7,5) * var(:,7,:) + & - q(8,5) * var(:,8,:) + q(9,5) * var(:,9,:) ) * idel - dvar(:,6,:) = ( q(1,6) * var(:,1,:) + q(2,6) * var(:,2,:) + & - q(3,6) * var(:,3,:) + q(4,6) * var(:,4,:) + & - q(5,6) * var(:,5,:) + q(7,6) * var(:,7,:) + & - q(8,6) * var(:,8,:) + q(9,6) * var(:,9,:) + & - q(10,6) * var(:,10,:) ) * idel - dvar(:,7,:) = ( q(1,7) * var(:,1,:) + q(2,7) * var(:,2,:) + & - q(3,7) * var(:,3,:) + q(4,7) * var(:,4,:) + & - q(5,7) * var(:,5,:) + q(6,7) * var(:,6,:) + & - q(8,7) * var(:,8,:) + q(9,7) * var(:,9,:) + & - q(10,7) * var(:,10,:) + q(11,7) * var(:,11,:) ) * idel - dvar(:,8,:) = ( q(1,8) * var(:,1,:) + q(2,8) * var(:,2,:) + & - q(3,8) * var(:,3,:) + q(4,8) * var(:,4,:) + & - q(5,8) * var(:,5,:) + q(6,8) * var(:,6,:) + & - q(7,8) * var(:,7,:) + q(9,8) * var(:,9,:) + & - q(10,8) * var(:,10,:) + q(11,8) * var(:,11,:) + & - q(12,8) * var(:,12,:) ) * idel - jl = 9 + dvar(:,1+ol,:) = ( q(1,1) * var(:,1+ol,:) + q(2,1) * var(:,2+ol,:) + & + q(3,1) * var(:,3+ol,:) + q(4,1) * var(:,4+ol,:) + & + q(5,1) * var(:,5+ol,:) + q(6,1) * var(:,6+ol,:) + & + q(7,1) * var(:,7+ol,:) + q(8,1) * var(:,8+ol,:) ) * idel + dvar(:,2+ol,:) = ( q(1,2) * var(:,1+ol,:) + q(3,2) * var(:,3+ol,:) + & + q(4,2) * var(:,4+ol,:) + q(5,2) * var(:,5+ol,:) + & + q(6,2) * var(:,6+ol,:) + q(7,2) * var(:,7+ol,:) + & + q(8,2) * var(:,8+ol,:) ) * idel + dvar(:,3+ol,:) = ( q(1,3) * var(:,1+ol,:) + q(2,3) * var(:,2+ol,:) + & + q(4,3) * var(:,4+ol,:) + q(5,3) * var(:,5+ol,:) + & + q(6,3) * var(:,6+ol,:) + q(7,3) * var(:,7+ol,:) + & + q(8,3) * var(:,8+ol,:) ) * idel + dvar(:,4+ol,:) = ( q(1,4) * var(:,1+ol,:) + q(2,4) * var(:,2+ol,:) + & + q(3,4) * var(:,3+ol,:) + q(5,4) * var(:,5+ol,:) + & + q(6,4) * var(:,6+ol,:) + q(7,4) * var(:,7+ol,:) + & + q(8,4) * var(:,8+ol,:) ) * idel + dvar(:,5+ol,:) = ( q(1,5) * var(:,1+ol,:) + q(2,5) * var(:,2+ol,:) + & + q(3,5) * var(:,3+ol,:) + q(4,5) * var(:,4+ol,:) + & + q(6,5) * var(:,6+ol,:) + q(7,5) * var(:,7+ol,:) + & + q(8,5) * var(:,8+ol,:) + q(9,5) * var(:,9+ol,:) ) * idel + dvar(:,6+ol,:) = ( q(1,6) * var(:,1+ol,:) + q(2,6) * var(:,2+ol,:) + & + q(3,6) * var(:,3+ol,:) + q(4,6) * var(:,4+ol,:) + & + q(5,6) * var(:,5+ol,:) + q(7,6) * var(:,7+ol,:) + & + q(8,6) * var(:,8+ol,:) + q(9,6) * var(:,9+ol,:) + & + q(10,6) * var(:,10+ol,:) ) * idel + dvar(:,7+ol,:) = ( q(1,7) * var(:,1+ol,:) + q(2,7) * var(:,2+ol,:) + & + q(3,7) * var(:,3+ol,:) + q(4,7) * var(:,4+ol,:) + & + q(5,7) * var(:,5+ol,:) + q(6,7) * var(:,6+ol,:) + & + q(8,7) * var(:,8+ol,:) + q(9,7) * var(:,9+ol,:) + & + q(10,7) * var(:,10+ol,:) + q(11,7) * var(:,11+ol,:) ) * idel + dvar(:,8+ol,:) = ( q(1,8) * var(:,1+ol,:) + q(2,8) * var(:,2+ol,:) + & + q(3,8) * var(:,3+ol,:) + q(4,8) * var(:,4+ol,:) + & + q(5,8) * var(:,5+ol,:) + q(6,8) * var(:,6+ol,:) + & + q(7,8) * var(:,7+ol,:) + q(9,8) * var(:,9+ol,:) + & + q(10,8) * var(:,10+ol,:) + q(11,8) * var(:,11+ol,:) + & + q(12,8) * var(:,12+ol,:) ) * idel + jl = 9 + ol end if if ( bb(2) == 0 ) then jr = nj - gsize else - dvar(:,nj,:) = - ( q(1,1) * var(:,nj,:) + q(2,1) * var(:,nj-1,:) + & - q(3,1) * var(:,nj-2,:) + q(4,1) * var(:,nj-3,:) + & - q(5,1) * var(:,nj-4,:) + q(6,1) * var(:,nj-5,:) + & - q(7,1) * var(:,nj-6,:) + & - q(8,1) * var(:,nj-7,:) ) * idel - dvar(:,nj-1,:) = - ( q(1,2) * var(:,nj,:) + q(3,2) * var(:,nj-2,:) + & - q(4,2) * var(:,nj-3,:) + q(5,2) * var(:,nj-4,:) + & - q(6,2) * var(:,nj-5,:) + q(7,2) * var(:,nj-6,:) + & - q(8,2) * var(:,nj-7,:) ) * idel - dvar(:,nj-2,:) = - ( q(1,3) * var(:,nj,:) + q(2,3) * var(:,nj-1,:) + & - q(4,3) * var(:,nj-3,:) + q(5,3) * var(:,nj-4,:) + & - q(6,3) * var(:,nj-5,:) + q(7,3) * var(:,nj-6,:) + & - q(8,3) * var(:,nj-7,:) ) * idel - dvar(:,nj-3,:) = - ( q(1,4) * var(:,nj,:) + q(2,4) * var(:,nj-1,:) + & - q(3,4) * var(:,nj-2,:) + q(5,4) * var(:,nj-4,:) + & - q(6,4) * var(:,nj-5,:) + q(7,4) * var(:,nj-6,:) + & - q(8,4) * var(:,nj-7,:) ) * idel - dvar(:,nj-4,:) = - ( q(1,5) * var(:,nj,:) + q(2,5) * var(:,nj-1,:) + & - q(3,5) * var(:,nj-2,:) + q(4,5) * var(:,nj-3,:) + & - q(6,5) * var(:,nj-5,:) + q(7,5) * var(:,nj-6,:) + & - q(8,5) * var(:,nj-7,:) + & - q(9,5) * var(:,nj-8,:) ) * idel - dvar(:,nj-5,:) = - ( q(1,6) * var(:,nj,:) + q(2,6) * var(:,nj-1,:) + & - q(3,6) * var(:,nj-2,:) + q(4,6) * var(:,nj-3,:) + & - q(5,6) * var(:,nj-4,:) + q(7,6) * var(:,nj-6,:) + & - q(8,6) * var(:,nj-7,:) + q(9,6) * var(:,nj-8,:) + & - q(10,6) * var(:,nj-9,:) ) * idel - dvar(:,nj-6,:) = - ( q(1,7) * var(:,nj,:) + q(2,7) * var(:,nj-1,:) + & - q(3,7) * var(:,nj-2,:) + q(4,7) * var(:,nj-3,:) + & - q(5,7) * var(:,nj-4,:) + q(6,7) * var(:,nj-5,:) + & - q(8,7) * var(:,nj-7,:) + q(9,7) * var(:,nj-8,:) + & - q(10,7) * var(:,nj-9,:) + & - q(11,7) * var(:,nj-10,:) ) * idel - dvar(:,nj-7,:) = - ( q(1,8) * var(:,nj,:) + q(2,8) * var(:,nj-1,:) + & - q(3,8) * var(:,nj-2,:) + q(4,8) * var(:,nj-3,:) + & - q(5,8) * var(:,nj-4,:) + q(6,8) * var(:,nj-5,:) + & - q(7,8) * var(:,nj-6,:) + q(9,8) * var(:,nj-8,:) + & - q(10,8) * var(:,nj-9,:) + & - q(11,8) * var(:,nj-10,:) + & - q(12,8) * var(:,nj-11,:) ) * idel - jr = nj - 8 + dvar(:,nj-or,:) = - ( q(1,1) * var(:,nj-or,:) + q(2,1) * var(:,nj-1-or,:) + & + q(3,1) * var(:,nj-2-or,:) + q(4,1) * var(:,nj-3-or,:) + & + q(5,1) * var(:,nj-4-or,:) + q(6,1) * var(:,nj-5-or,:) + & + q(7,1) * var(:,nj-6-or,:) + & + q(8,1) * var(:,nj-7-or,:) ) * idel + dvar(:,nj-1-or,:) = - ( q(1,2) * var(:,nj-or,:) + q(3,2) * var(:,nj-2-or,:) + & + q(4,2) * var(:,nj-3-or,:) + q(5,2) * var(:,nj-4-or,:) + & + q(6,2) * var(:,nj-5-or,:) + q(7,2) * var(:,nj-6-or,:) + & + q(8,2) * var(:,nj-7-or,:) ) * idel + dvar(:,nj-2-or,:) = - ( q(1,3) * var(:,nj-or,:) + q(2,3) * var(:,nj-1-or,:) + & + q(4,3) * var(:,nj-3-or,:) + q(5,3) * var(:,nj-4-or,:) + & + q(6,3) * var(:,nj-5-or,:) + q(7,3) * var(:,nj-6-or,:) + & + q(8,3) * var(:,nj-7-or,:) ) * idel + dvar(:,nj-3-or,:) = - ( q(1,4) * var(:,nj-or,:) + q(2,4) * var(:,nj-1-or,:) + & + q(3,4) * var(:,nj-2-or,:) + q(5,4) * var(:,nj-4-or,:) + & + q(6,4) * var(:,nj-5-or,:) + q(7,4) * var(:,nj-6-or,:) + & + q(8,4) * var(:,nj-7-or,:) ) * idel + dvar(:,nj-4-or,:) = - ( q(1,5) * var(:,nj-or,:) + q(2,5) * var(:,nj-1-or,:) + & + q(3,5) * var(:,nj-2-or,:) + q(4,5) * var(:,nj-3-or,:) + & + q(6,5) * var(:,nj-5-or,:) + q(7,5) * var(:,nj-6-or,:) + & + q(8,5) * var(:,nj-7-or,:) + & + q(9,5) * var(:,nj-8-or,:) ) * idel + dvar(:,nj-5-or,:) = - ( q(1,6) * var(:,nj-or,:) + q(2,6) * var(:,nj-1-or,:) + & + q(3,6) * var(:,nj-2-or,:) + q(4,6) * var(:,nj-3-or,:) + & + q(5,6) * var(:,nj-4-or,:) + q(7,6) * var(:,nj-6-or,:) + & + q(8,6) * var(:,nj-7-or,:) + q(9,6) * var(:,nj-8-or,:) + & + q(10,6) * var(:,nj-9-or,:) ) * idel + dvar(:,nj-6-or,:) = - ( q(1,7) * var(:,nj-or,:) + q(2,7) * var(:,nj-1-or,:) + & + q(3,7) * var(:,nj-2-or,:) + q(4,7) * var(:,nj-3-or,:) + & + q(5,7) * var(:,nj-4-or,:) + q(6,7) * var(:,nj-5-or,:) + & + q(8,7) * var(:,nj-7-or,:) + q(9,7) * var(:,nj-8-or,:) + & + q(10,7) * var(:,nj-9-or,:) + & + q(11,7) * var(:,nj-10-or,:) ) * idel + dvar(:,nj-7-or,:) = - ( q(1,8) * var(:,nj-or,:) + q(2,8) * var(:,nj-1-or,:) + & + q(3,8) * var(:,nj-2-or,:) + q(4,8) * var(:,nj-3-or,:) + & + q(5,8) * var(:,nj-4-or,:) + q(6,8) * var(:,nj-5-or,:) + & + q(7,8) * var(:,nj-6-or,:) + q(9,8) * var(:,nj-8-or,:) + & + q(10,8) * var(:,nj-9-or,:) + & + q(11,8) * var(:,nj-10-or,:) + & + q(12,8) * var(:,nj-11-or,:) ) * idel + jr = nj - 8 - or end if if (jl > jr+1) call CCTK_WARN (0, "domain too small") dvar(:,jl:jr,:) = ( a(1) * ( var(:,jl+1:jr+1,:) - & @@ -333,94 +237,95 @@ subroutine deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, dvar ) var(:,jl-4:jr-4,:) ) ) * idel end if case (2) direction + ol = offset(1); or = offset(2) if ( zero_derivs_z /= 0 ) then dvar = zero else if ( bb(1) == 0 ) then kl = 1 + gsize else - dvar(:,:,1) = ( q(1,1) * var(:,:,1) + q(2,1) * var(:,:,2) + & - q(3,1) * var(:,:,3) + q(4,1) * var(:,:,4) + & - q(5,1) * var(:,:,5) + q(6,1) * var(:,:,6) + & - q(7,1) * var(:,:,7) + q(8,1) * var(:,:,8) ) * idel - dvar(:,:,2) = ( q(1,2) * var(:,:,1) + q(3,2) * var(:,:,3) + & - q(4,2) * var(:,:,4) + q(5,2) * var(:,:,5) + & - q(6,2) * var(:,:,6) + q(7,2) * var(:,:,7) + & - q(8,2) * var(:,:,8) ) * idel - dvar(:,:,3) = ( q(1,3) * var(:,:,1) + q(2,3) * var(:,:,2) + & - q(4,3) * var(:,:,4) + q(5,3) * var(:,:,5) + & - q(6,3) * var(:,:,6) + q(7,3) * var(:,:,7) + & - q(8,3) * var(:,:,8) ) * idel - dvar(:,:,4) = ( q(1,4) * var(:,:,1) + q(2,4) * var(:,:,2) + & - q(3,4) * var(:,:,3) + q(5,4) * var(:,:,5) + & - q(6,4) * var(:,:,6) + q(7,4) * var(:,:,7) + & - q(8,4) * var(:,:,8) ) * idel - dvar(:,:,5) = ( q(1,5) * var(:,:,1) + q(2,5) * var(:,:,2) + & - q(3,5) * var(:,:,3) + q(4,5) * var(:,:,4) + & - q(6,5) * var(:,:,6) + q(7,5) * var(:,:,7) + & - q(8,5) * var(:,:,8) + q(9,5) * var(:,:,9) ) * idel - dvar(:,:,6) = ( q(1,6) * var(:,:,1) + q(2,6) * var(:,:,2) + & - q(3,6) * var(:,:,3) + q(4,6) * var(:,:,4) + & - q(5,6) * var(:,:,5) + q(7,6) * var(:,:,7) + & - q(8,6) * var(:,:,8) + q(9,6) * var(:,:,9) + & - q(10,6) * var(:,:,10) ) * idel - dvar(:,:,7) = ( q(1,7) * var(:,:,1) + q(2,7) * var(:,:,2) + & - q(3,7) * var(:,:,3) + q(4,7) * var(:,:,4) + & - q(5,7) * var(:,:,5) + q(6,7) * var(:,:,6) + & - q(8,7) * var(:,:,8) + q(9,7) * var(:,:,9) + & - q(10,7) * var(:,:,10) + q(11,7) * var(:,:,11) ) * idel - dvar(:,:,8) = ( q(1,8) * var(:,:,1) + q(2,8) * var(:,:,2) + & - q(3,8) * var(:,:,3) + q(4,8) * var(:,:,4) + & - q(5,8) * var(:,:,5) + q(6,8) * var(:,:,6) + & - q(7,8) * var(:,:,7) + q(9,8) * var(:,:,9) + & - q(10,8) * var(:,:,10) + q(11,8) * var(:,:,11) + & - q(12,8) * var(:,:,12) ) * idel - kl = 9 + dvar(:,:,1+ol) = ( q(1,1) * var(:,:,1+ol) + q(2,1) * var(:,:,2+ol) + & + q(3,1) * var(:,:,3+ol) + q(4,1) * var(:,:,4+ol) + & + q(5,1) * var(:,:,5+ol) + q(6,1) * var(:,:,6+ol) + & + q(7,1) * var(:,:,7+ol) + q(8,1) * var(:,:,8+ol) ) * idel + dvar(:,:,2+ol) = ( q(1,2) * var(:,:,1+ol) + q(3,2) * var(:,:,3+ol) + & + q(4,2) * var(:,:,4+ol) + q(5,2) * var(:,:,5+ol) + & + q(6,2) * var(:,:,6+ol) + q(7,2) * var(:,:,7+ol) + & + q(8,2) * var(:,:,8+ol) ) * idel + dvar(:,:,3+ol) = ( q(1,3) * var(:,:,1+ol) + q(2,3) * var(:,:,2+ol) + & + q(4,3) * var(:,:,4+ol) + q(5,3) * var(:,:,5+ol) + & + q(6,3) * var(:,:,6+ol) + q(7,3) * var(:,:,7+ol) + & + q(8,3) * var(:,:,8+ol) ) * idel + dvar(:,:,4+ol) = ( q(1,4) * var(:,:,1+ol) + q(2,4) * var(:,:,2+ol) + & + q(3,4) * var(:,:,3+ol) + q(5,4) * var(:,:,5+ol) + & + q(6,4) * var(:,:,6+ol) + q(7,4) * var(:,:,7+ol) + & + q(8,4) * var(:,:,8+ol) ) * idel + dvar(:,:,5+ol) = ( q(1,5) * var(:,:,1+ol) + q(2,5) * var(:,:,2+ol) + & + q(3,5) * var(:,:,3+ol) + q(4,5) * var(:,:,4+ol) + & + q(6,5) * var(:,:,6+ol) + q(7,5) * var(:,:,7+ol) + & + q(8,5) * var(:,:,8+ol) + q(9,5) * var(:,:,9+ol) ) * idel + dvar(:,:,6+ol) = ( q(1,6) * var(:,:,1+ol) + q(2,6) * var(:,:,2+ol) + & + q(3,6) * var(:,:,3+ol) + q(4,6) * var(:,:,4+ol) + & + q(5,6) * var(:,:,5+ol) + q(7,6) * var(:,:,7+ol) + & + q(8,6) * var(:,:,8+ol) + q(9,6) * var(:,:,9+ol) + & + q(10,6) * var(:,:,10+ol) ) * idel + dvar(:,:,7+ol) = ( q(1,7) * var(:,:,1+ol) + q(2,7) * var(:,:,2+ol) + & + q(3,7) * var(:,:,3+ol) + q(4,7) * var(:,:,4+ol) + & + q(5,7) * var(:,:,5+ol) + q(6,7) * var(:,:,6+ol) + & + q(8,7) * var(:,:,8+ol) + q(9,7) * var(:,:,9+ol) + & + q(10,7) * var(:,:,10+ol) + q(11,7) * var(:,:,11+ol) ) * idel + dvar(:,:,8+ol) = ( q(1,8) * var(:,:,1+ol) + q(2,8) * var(:,:,2+ol) + & + q(3,8) * var(:,:,3+ol) + q(4,8) * var(:,:,4+ol) + & + q(5,8) * var(:,:,5+ol) + q(6,8) * var(:,:,6+ol) + & + q(7,8) * var(:,:,7+ol) + q(9,8) * var(:,:,9+ol) + & + q(10,8) * var(:,:,10+ol) + q(11,8) * var(:,:,11+ol) + & + q(12,8) * var(:,:,12+ol) ) * idel + kl = 9 + ol end if if ( bb(2) == 0 ) then kr = nk - gsize else - dvar(:,:,nk) = - ( q(1,1) * var(:,:,nk) + q(2,1) * var(:,:,nk-1) + & - q(3,1) * var(:,:,nk-2) + q(4,1) * var(:,:,nk-3) + & - q(5,1) * var(:,:,nk-4) + q(6,1) * var(:,:,nk-5) + & - q(7,1) * var(:,:,nk-6) + & - q(8,1) * var(:,:,nk-7) ) * idel - dvar(:,:,nk-1) = - ( q(1,2) * var(:,:,nk) + q(3,2) * var(:,:,nk-2) + & - q(4,2) * var(:,:,nk-3) + q(5,2) * var(:,:,nk-4) + & - q(6,2) * var(:,:,nk-5) + q(7,2) * var(:,:,nk-6) + & - q(8,2) * var(:,:,nk-7) ) * idel - dvar(:,:,nk-2) = - ( q(1,3) * var(:,:,nk) + q(2,3) * var(:,:,nk-1) + & - q(4,3) * var(:,:,nk-3) + q(5,3) * var(:,:,nk-4) + & - q(6,3) * var(:,:,nk-5) + q(7,3) * var(:,:,nk-6) + & - q(8,3) * var(:,:,nk-7) ) * idel - dvar(:,:,nk-3) = - ( q(1,4) * var(:,:,nk) + q(2,4) * var(:,:,nk-1) + & - q(3,4) * var(:,:,nk-2) + q(5,4) * var(:,:,nk-4) + & - q(6,4) * var(:,:,nk-5) + q(7,4) * var(:,:,nk-6) + & - q(8,4) * var(:,:,nk-7) ) * idel - dvar(:,:,nk-4) = - ( q(1,5) * var(:,:,nk) + q(2,5) * var(:,:,nk-1) + & - q(3,5) * var(:,:,nk-2) + q(4,5) * var(:,:,nk-3) + & - q(6,5) * var(:,:,nk-5) + q(7,5) * var(:,:,nk-6) + & - q(8,5) * var(:,:,nk-7) + & - q(9,5) * var(:,:,nk-8) ) * idel - dvar(:,:,nk-5) = - ( q(1,6) * var(:,:,nk) + q(2,6) * var(:,:,nk-1) + & - q(3,6) * var(:,:,nk-2) + q(4,6) * var(:,:,nk-3) + & - q(5,6) * var(:,:,nk-4) + q(7,6) * var(:,:,nk-6) + & - q(8,6) * var(:,:,nk-7) + q(9,6) * var(:,:,nk-8) + & - q(10,6) * var(:,:,nk-9) ) * idel - dvar(:,:,nk-6) = - ( q(1,7) * var(:,:,nk) + q(2,7) * var(:,:,nk-1) + & - q(3,7) * var(:,:,nk-2) + q(4,7) * var(:,:,nk-3) + & - q(5,7) * var(:,:,nk-4) + q(6,7) * var(:,:,nk-5) + & - q(8,7) * var(:,:,nk-7) + q(9,7) * var(:,:,nk-8) + & - q(10,7) * var(:,:,nk-9) + & - q(11,7) * var(:,:,nk-10) ) * idel - dvar(:,:,nk-7) = - ( q(1,8) * var(:,:,nk) + q(2,8) * var(:,:,nk-1) + & - q(3,8) * var(:,:,nk-2) + q(4,8) * var(:,:,nk-3) + & - q(5,8) * var(:,:,nk-4) + q(6,8) * var(:,:,nk-5) + & - q(7,8) * var(:,:,nk-6) + q(9,8) * var(:,:,nk-8) + & - q(10,8) * var(:,:,nk-9) + & - q(11,8) * var(:,:,nk-10) + & - q(12,8) * var(:,:,nk-11) ) * idel - kr = nk - 8 + dvar(:,:,nk-or) = - ( q(1,1) * var(:,:,nk-or) + q(2,1) * var(:,:,nk-1-or) + & + q(3,1) * var(:,:,nk-2-or) + q(4,1) * var(:,:,nk-3-or) + & + q(5,1) * var(:,:,nk-4-or) + q(6,1) * var(:,:,nk-5-or) + & + q(7,1) * var(:,:,nk-6-or) + & + q(8,1) * var(:,:,nk-7-or) ) * idel + dvar(:,:,nk-1-or) = - ( q(1,2) * var(:,:,nk-or) + q(3,2) * var(:,:,nk-2-or) + & + q(4,2) * var(:,:,nk-3-or) + q(5,2) * var(:,:,nk-4-or) + & + q(6,2) * var(:,:,nk-5-or) + q(7,2) * var(:,:,nk-6-or) + & + q(8,2) * var(:,:,nk-7-or) ) * idel + dvar(:,:,nk-2-or) = - ( q(1,3) * var(:,:,nk-or) + q(2,3) * var(:,:,nk-1-or) + & + q(4,3) * var(:,:,nk-3-or) + q(5,3) * var(:,:,nk-4-or) + & + q(6,3) * var(:,:,nk-5-or) + q(7,3) * var(:,:,nk-6-or) + & + q(8,3) * var(:,:,nk-7-or) ) * idel + dvar(:,:,nk-3-or) = - ( q(1,4) * var(:,:,nk-or) + q(2,4) * var(:,:,nk-1-or) + & + q(3,4) * var(:,:,nk-2-or) + q(5,4) * var(:,:,nk-4-or) + & + q(6,4) * var(:,:,nk-5-or) + q(7,4) * var(:,:,nk-6-or) + & + q(8,4) * var(:,:,nk-7-or) ) * idel + dvar(:,:,nk-4-or) = - ( q(1,5) * var(:,:,nk-or) + q(2,5) * var(:,:,nk-1-or) + & + q(3,5) * var(:,:,nk-2-or) + q(4,5) * var(:,:,nk-3-or) + & + q(6,5) * var(:,:,nk-5-or) + q(7,5) * var(:,:,nk-6-or) + & + q(8,5) * var(:,:,nk-7-or) + & + q(9,5) * var(:,:,nk-8-or) ) * idel + dvar(:,:,nk-5-or) = - ( q(1,6) * var(:,:,nk-or) + q(2,6) * var(:,:,nk-1-or) + & + q(3,6) * var(:,:,nk-2-or) + q(4,6) * var(:,:,nk-3-or) + & + q(5,6) * var(:,:,nk-4-or) + q(7,6) * var(:,:,nk-6-or) + & + q(8,6) * var(:,:,nk-7-or) + q(9,6) * var(:,:,nk-8-or) + & + q(10,6) * var(:,:,nk-9-or) ) * idel + dvar(:,:,nk-6-or) = - ( q(1,7) * var(:,:,nk-or) + q(2,7) * var(:,:,nk-1-or) + & + q(3,7) * var(:,:,nk-2-or) + q(4,7) * var(:,:,nk-3-or) + & + q(5,7) * var(:,:,nk-4-or) + q(6,7) * var(:,:,nk-5-or) + & + q(8,7) * var(:,:,nk-7-or) + q(9,7) * var(:,:,nk-8-or) + & + q(10,7) * var(:,:,nk-9-or) + & + q(11,7) * var(:,:,nk-10-or) ) * idel + dvar(:,:,nk-7-or) = - ( q(1,8) * var(:,:,nk-or) + q(2,8) * var(:,:,nk-1-or) + & + q(3,8) * var(:,:,nk-2-or) + q(4,8) * var(:,:,nk-3-or) + & + q(5,8) * var(:,:,nk-4-or) + q(6,8) * var(:,:,nk-5-or) + & + q(7,8) * var(:,:,nk-6-or) + q(9,8) * var(:,:,nk-8-or) + & + q(10,8) * var(:,:,nk-9-or) + & + q(11,8) * var(:,:,nk-10-or) + & + q(12,8) * var(:,:,nk-11-or) ) * idel + kr = nk - 8 - or end if if (kl > kr+1) call CCTK_WARN (0, "domain too small") dvar(:,:,kl:kr) = ( a(1) * ( var(:,:,kl+1:kr+1) - & @@ -437,13 +342,13 @@ end subroutine deriv_gf_8_4_opt subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dvar ) + use All_Coeffs_mod + implicit none DECLARE_CCTK_FUNCTIONS DECLARE_CCTK_PARAMETERS - CCTK_REAL, parameter :: zero = 0.0 - integer, parameter :: wp = kind(zero) CCTK_INT, intent(IN) :: ni, nj, nk CCTK_REAL, dimension(ni,nj,nk), intent(IN) :: var CCTK_INT, intent(IN) :: dir @@ -462,220 +367,7 @@ subroutine up_deriv_gf_8_4_opt ( var, ni, nj, nk, dir, bb, gsize, delta, up, dva logical, save :: first = .true. if ( first ) then - a1(-4) = 0.007142857142857142857142857142857142857143_wp - a1(-3) = -0.06666666666666666666666666666666666666667_wp - a1(-2) = 0.3000000000000000000000000000000000000000_wp - a1(-1) = -1.000000000000000000000000000000000000000_wp - a1(0) = 0.2500000000000000000000000000000000000000_wp - a1(1) = 0.6000000000000000000000000000000000000000_wp - a1(2) = -0.1000000000000000000000000000000000000000_wp - a1(3) = 0.009523809523809523809523809523809523809524_wp - a1(4) = 0.0_wp - - q1(1,1) = -1.683432578685956376544499542432311020539_wp - q1(2,1) = 2.206194911574014373726323572790957192479_wp - q1(3,1) = 0.01048240012328238642042347285056590509052_wp - q1(4,1) = -0.7964177278055455600674641925035752355813_wp - q1(5,1) = 0.04375559918421074726330123748705042737925_wp - q1(6,1) = 0.3015760468426855559502835132688146245819_wp - q1(7,1) = -0.05430139927462465206917597295687512552949_wp - q1(8,1) = -0.02785725195806647467919208850462676788091_wp - q1(9,1) = 0.0_wp - q1(10,1) = 0.0_wp - q1(11,1) = 0.0_wp - q1(12,1) = 0.0_wp - q1(1,2) = -0.4451389901846271204230470438663315357999_wp - q1(2,2) = 0.03979384217746298000464189244717138065595_wp - q1(3,2) = 0.04117629055092890361160914968898310705568_wp - q1(4,2) = 0.5200531283081606472663885367960872642342_wp - q1(5,2) = -0.04132093916257534380117029102933732094903_wp - q1(6,2) = -0.1571076966553020594965523100929511511562_wp - q1(7,2) = 0.02929412303865500620649355002594213960776_wp - q1(8,2) = 0.01325024192729698663163651603043611635147_wp - q1(9,2) = 0.0_wp - q1(10,2) = 0.0_wp - q1(11,2) = 0.0_wp - q1(12,2) = 0.0_wp - q1(1,3) = 0.1544592597396873173299548977341719367844_wp - q1(2,3) = -1.020860666961436408391054234781341175626_wp - q1(3,3) = 0.7352247001589518809305910119936419247628_wp - q1(4,3) = -0.1443377614671085870438942853092495421459_wp - q1(5,3) = 0.4029099592852542668089969628980513126845_wp - q1(6,3) = -0.1256847607545176255327746274725689708913_wp - q1(7,3) = -0.01218362768224537680217842793138395523727_wp - q1(8,3) = 0.01047289768141453270035870286867846966855_wp - q1(9,3) = 0.0_wp - q1(10,3) = 0.0_wp - q1(11,3) = 0.0_wp - q1(12,3) = 0.0_wp - q1(1,4) = 0.1147228529148158318034738218073197976023_wp - q1(2,4) = -0.3538780254601914958115698874206531961307_wp - q1(3,4) = -0.1858994785495101740456777336107169678288_wp - q1(4,4) = 0.1370483808799853486477767415913728669524_wp - q1(5,4) = 0.03972858582710281564215102156521588367881_wp - q1(6,4) = 0.3165092134256211709442618752193670178495_wp - q1(7,4) = -0.05069213274750316093259254157360772183295_wp - q1(8,4) = -0.01753939629032033624782329757829768029059_wp - q1(9,4) = 0.0_wp - q1(10,4) = 0.0_wp - q1(11,4) = 0.0_wp - q1(12,4) = 0.0_wp - q1(1,5) = -0.01395722952056041916292538026746562805620_wp - q1(2,5) = 0.01429909551156929498323180030121632055909_wp - q1(3,5) = 0.2332633686362482363893930312775209255800_wp - q1(4,5) = -1.142300242635165935993053851544552454320_wp - q1(5,5) = 0.6057550738330768177827040634066377989296_wp - q1(6,5) = 0.2825179352075121763892365873707254541218_wp - q1(7,5) = 0.03248906901967492013975174489420235738435_wp - q1(8,5) = -0.01206707005235509052833799543828477419916_wp - q1(9,5) = 0.0_wp - q1(10,5) = 0.0_wp - q1(11,5) = 0.0_wp - q1(12,5) = 0.0_wp - q1(1,6) = -0.06956044896551484587496684695381321009857_wp - q1(2,6) = 0.1930764794969705526456194423505107491362_wp - q1(3,6) = -0.01938619631973248083178041998353003089641_wp - q1(4,6) = -0.2887164590533642022788579933885334942677_wp - q1(5,6) = -0.4040701147451219074780049288053335780831_wp - q1(6,6) = 0.1955440022503079624043376625896000853565_wp - q1(7,6) = 0.4088327186474708718613662440475307694516_wp - q1(8,6) = -0.02316927663483720615835459462174938908831_wp - q1(9,6) = 0.007449295323821255710641434765318098489772_wp - q1(10,6) = 0.0_wp - q1(11,6) = 0.0_wp - q1(12,6) = 0.0_wp - q1(1,7) = 0.01734328280101122760645584447264624051821_wp - q1(2,7) = -0.04840773491893482968357096782164797435370_wp - q1(3,7) = 0.01113356043999974094579726795398111697087_wp - q1(4,7) = 0.03683258325116868830333840353178374785556_wp - q1(5,7) = 0.2020929196538139300412937632456998385290_wp - q1(6,7) = -0.9993401510385675084229179036326626049945_wp - q1(7,7) = 0.2707691940348400441134114620253070105404_wp - q1(8,7) = 0.6075690064749917706800934212435751620821_wp - q1(9,7) = -0.1083076776139360176453645848101228042161_wp - q1(10,7) = 0.01031501691561295406146329379144026706820_wp - q1(11,7) = 0.0_wp - q1(12,7) = 0.0_wp - q1(1,8) = 0.008138876723484902470545040666116789759842_wp - q1(2,8) = -0.02002921745130282774392822052620050919550_wp - q1(3,8) = -0.002671343688148396036480262140129972226295_wp - q1(4,8) = 0.03832298452325717814060194729385919629895_wp - q1(5,8) = -0.05168030333817646678101782026786038350804_wp - q1(6,8) = 0.2274981280312773565363597229555297756596_wp - q1(7,8) = -0.9520792032950265164134838698189786312337_wp - q1(8,8) = 0.2476881136110866797237534905735256806167_wp - q1(9,8) = 0.5944514726666080313370083773764616334802_wp - q1(10,8) = -0.09907524544443467188950139622941027224670_wp - q1(11,8) = 0.009435737661374730656142990117086692594923_wp - q1(12,8) = 0.0_wp - - a2(-4) = 0.0_wp - a2(-3) = -0.009523809523809523809523809523809523809524_wp - a2(-2) = 0.1000000000000000000000000000000000000000_wp - a2(-1) = -0.6000000000000000000000000000000000000000_wp - a2(0) = -0.2500000000000000000000000000000000000000_wp - a2(1) = 1.000000000000000000000000000000000000000_wp - a2(2) = -0.3000000000000000000000000000000000000000_wp - a2(3) = 0.06666666666666666666666666666666666666667_wp - a2(4) = -0.007142857142857142857142857142857142857143_wp - - q2(1,1) = -1.707654630177840640955211766064430603569_wp - q2(2,1) = 2.303083117541551431369172467319435524597_wp - q2(3,1) = -0.1348499088280232000438498689421515930856_wp - q2(4,1) = -0.6995295218380085024246152979750969034639_wp - q2(5,1) = 0.01953354769232648285258901385493084434991_wp - q2(6,1) = 0.3015760468426855559502835132688146245819_wp - q2(7,1) = -0.05430139927462465206917597295687512552949_wp - q2(8,1) = -0.02785725195806647467919208850462676788091_wp - q2(9,1) = 0.0_wp - q2(10,1) = 0.0_wp - q2(11,1) = 0.0_wp - q2(12,1) = 0.0_wp - q2(1,2) = -0.4264124762187621886561567415382508860795_wp - q2(2,2) = -0.03979384217746298000464189244717138065595_wp - q2(3,2) = 0.1722618883119834259798412659855476550988_wp - q2(4,2) = 0.4170573014959035225484918739916436907718_wp - q2(5,2) = -0.003867911230845480267389686373176021508129_wp - q2(6,2) = -0.1617893251467682924382748856749713135863_wp - q2(7,2) = 0.02929412303865500620649355002594213960776_wp - q2(8,2) = 0.01325024192729698663163651603043611635147_wp - q2(9,2) = 0.0_wp - q2(10,2) = 0.0_wp - q2(11,2) = 0.0_wp - q2(12,2) = 0.0_wp - q2(1,3) = -0.01200671010762254250338646347193566882227_wp - q2(2,3) = -0.2440194743406570625021278824861723494614_wp - q2(3,3) = -0.7352247001589518809305910119936419247628_wp - q2(4,3) = 1.298367310542910198178397511810349706445_wp - q2(5,3) = -0.3739312333355250790799293893971175134799_wp - q2(6,3) = 0.09626986570856218757834718746890783658430_wp - q2(7,3) = -0.03992795599013035344106865479906855617172_wp - q2(8,3) = 0.01047289768141453270035870286867846966855_wp - q2(9,3) = 0.0_wp - q2(10,3) = 0.0_wp - q2(11,3) = 0.0_wp - q2(12,3) = 0.0_wp - q2(1,4) = 0.1306125202632199301974189512671891155098_wp - q2(2,4) = -0.4412711958764140369782680994499344446221_wp - q2(3,4) = 0.02066619697974310507560894936758416496903_wp - q2(4,4) = -0.1370483808799853486477767415913728669524_wp - q2(5,4) = 0.2621839287047601931573828340033863343841_wp - q2(6,4) = 0.2052815419867924821866459690002817924969_wp - q2(7,4) = -0.01891279805069496414470228265386908601791_wp - q2(8,4) = -0.02151181312742136084630957994326500976747_wp - q2(9,4) = 0.0_wp - q2(10,4) = 0.0_wp - q2(11,4) = 0.0_wp - q2(12,4) = 0.0_wp - q2(1,5) = -0.03126451734436261395671692493622670802562_wp - q2(2,5) = 0.1527573981019868533335641576513049603144_wp - q2(3,5) = -0.2513406904302132178367702194477893135637_wp - q2(4,5) = -0.1730921245022430275407273500939319760321_wp - q2(5,5) = -0.6057550738330768177827040634066377989296_wp - q2(6,5) = 1.251726053340435084841563088821345932409_wp - q2(7,5) = -0.4521149900467865340864115058311078817594_wp - q2(8,5) = 0.1263912325380624678219943619118038655562_wp - q2(9,5) = -0.01730728782380219479379154466876107996942_wp - q2(10,5) = 0.0_wp - q2(11,5) = 0.0_wp - q2(12,5) = 0.0_wp - q2(1,6) = -0.06956044896551484587496684695381321009857_wp - q2(2,6) = 0.1874895080041046108626383662765221752689_wp - q2(3,6) = 0.02530957562319505343206818860837856004222_wp - q2(4,6) = -0.4451516608536105722023281234602135625529_wp - q2(5,6) = -0.09119971114462916763106466866197344151272_wp - q2(6,6) = -0.1955440022503079624043376625896000853565_wp - q2(7,6) = 0.7217031222479636117083065041908909060220_wp - q2(8,6) = -0.1796044784350835760818247246934294573735_wp - q2(9,6) = 0.05214506726674878997449004335722668942840_wp - q2(10,6) = -0.005586971492865941782981076073988573867329_wp - q2(11,6) = 0.0_wp - q2(12,6) = 0.0_wp - q2(1,7) = 0.01734328280101122760645584447264624051821_wp - q2(2,7) = -0.04840773491893482968357096782164797435370_wp - q2(3,7) = 0.003397297753290025399699797610400916669720_wp - q2(4,7) = 0.09872268474484641267211816628042535026479_wp - q2(5,7) = -0.01452243557405810524943540637454576990329_wp - q2(6,7) = -0.5661094405828234378414595643921713881299_wp - q2(7,7) = -0.2707691940348400441134114620253070105404_wp - q2(8,7) = 1.040799716930735841261551760484066378947_wp - q2(9,7) = -0.3249230328418080529360937544303684126484_wp - q2(10,7) = 0.07220511840929067843024305654008186947743_wp - q2(11,7) = -0.007736262686709715546097470343580200301153_wp - q2(12,7) = 0.0_wp - q2(1,8) = 0.008138876723484902470545040666116789759842_wp - q2(2,8) = -0.02002921745130282774392822052620050919550_wp - q2(3,8) = -0.002671343688148396036480262140129972226295_wp - q2(4,8) = 0.03124618127722613014849470470604417685276_wp - q2(5,8) = 0.004934122630071917155840120434659772061498_wp - q2(6,8) = 0.02934763714240801275735693049670923116616_wp - q2(7,8) = -0.5557782215172878288554782849013375422469_wp - q2(8,8) = -0.2476881136110866797237534905735256806167_wp - q2(9,8) = 0.9907524544443467188950139622941027224670_wp - q2(10,8) = -0.2972257363333040156685041886882308167401_wp - q2(11,8) = 0.06605016362962311459300093081960684816446_wp - q2(12,8) = -0.007076803246031047992107242587815019446193_wp - + call coeffs_up_8_4_opt ( a1, q1, a2, q2 ) first = .false. end if diff --git a/src/call_derivs.c b/src/call_derivs.c index 22d6527..992e028 100644 --- a/src/call_derivs.c +++ b/src/call_derivs.c @@ -17,12 +17,15 @@ void DiffGv ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, DECLARE_CCTK_PARAMETERS DECLARE_CCTK_ARGUMENTS - CCTK_INT ni, nj, nk, gsize, loc_order; + CCTK_INT i, ni, nj, nk, gsize, loc_order; CCTK_REAL delta; - CCTK_INT bb[2]; + CCTK_INT bb[2], loc_offset[2]; int onesided[6]; - + CCTK_INT enforce_centered[6]; + CCTK_INT offset[6]; + CCTK_INT dummy[6]; int nelements; + void CCTK_FCALL CCTK_FNAME(deriv_gf_2_1)(const CCTK_REAL *var, const CCTK_INT *ni, const CCTK_INT *nj, @@ -111,6 +114,7 @@ void DiffGv ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, const CCTK_INT *dir, const CCTK_INT *bb, const CCTK_INT *gsize, + const CCTK_INT *offset, const CCTK_REAL *delta, CCTK_REAL *dvar); @@ -128,27 +132,88 @@ void DiffGv ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, loc_order = order; } + for (i=0; i<6; i++) { + enforce_centered[i] = 0; + } + + if ( table_handle >=0 ) { + nelements = Util_TableGetIntArray ( table_handle, 6, dummy, "enforce_centered" ); + if ( nelements == UTIL_ERROR_TABLE_NO_SUCH_KEY ) { + } else if ( nelements != 6) { + CCTK_WARN (0, "The options table has an entry \"enforce_centered\", but it does not have 6 elements"); + } else { + for (i=0; i<6; i++) { + enforce_centered[i] = dummy[i]; + } + } + } + + for (i=0; i<6; i++) { + offset[i] = 0; + } + if ( table_handle >=0 ) { + nelements = Util_TableGetIntArray ( table_handle, 6, dummy, "offset" ); + if ( nelements == UTIL_ERROR_TABLE_NO_SUCH_KEY ) { + } else if ( nelements != 6) { + CCTK_WARN (0, "The options table has an entry \"offset\", but it does not have 6 elements"); + } else { + for (i=0; i<6; i++) { + offset[i] = dummy[i]; + } + } + } + SBP_determine_onesided_stencil (cctkGH, onesided); switch(dir) { case 0: { delta = CCTK_DELTA_SPACE(0); - bb[0] = onesided[0]; - bb[1] = onesided[1]; + if ( enforce_centered[0] ) { + bb[0] = 0; + } else { + bb[0] = onesided[0]; + } + loc_offset[0] = offset[0]; + if ( enforce_centered[1] ) { + bb[1] = 0; + } else { + bb[1] = onesided[1]; + } + loc_offset[1] = offset[1]; gsize = cctk_nghostzones[0]; break; } case 1: { delta = CCTK_DELTA_SPACE(1); - bb[0] = onesided[2]; - bb[1] = onesided[3]; + if ( enforce_centered[2] ) { + bb[0] = 0; + } else { + bb[0] = onesided[2]; + } + loc_offset[0] = offset[2]; + if ( enforce_centered[3] ) { + bb[0] = 0; + } else { + bb[1] = onesided[3]; + } + loc_offset[1] = offset[3]; gsize = cctk_nghostzones[1]; break; } case 2: { delta = CCTK_DELTA_SPACE(2); - bb[0] = onesided[4]; - bb[1] = onesided[5]; + if ( enforce_centered[4] ) { + bb[0] = 0; + } else { + bb[0] = onesided[4]; + } + loc_offset[0] = offset[4]; + if ( enforce_centered[5] ) { + bb[0] = 0; + } else { + bb[1] = onesided[5]; + } + loc_offset[1] = offset[5]; gsize = cctk_nghostzones[2]; break; } @@ -193,7 +258,7 @@ void DiffGv ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, break; } case 8: { - CCTK_FNAME(deriv_gf_8_4_opt)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar); + CCTK_FNAME(deriv_gf_8_4_opt)(var,&ni,&nj,&nk,&dir,bb,&gsize,loc_offset,&delta,dvar); break; } default: diff --git a/src/call_derivs2.c b/src/call_derivs2.c new file mode 100644 index 0000000..23a5899 --- /dev/null +++ b/src/call_derivs2.c @@ -0,0 +1,106 @@ +#include "cctk.h" +#include "cctk_Parameters.h" +#include "cctk_Arguments.h" + +#include "util_ErrorCodes.h" +#include "util_Table.h" + +#include "stencil.h" + + + +void DiffGv2 ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, + const CCTK_REAL *var, CCTK_REAL *dvar2, + const CCTK_INT table_handle ) +{ + cGH const * restrict const cctkGH = cctkGH_; + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_ARGUMENTS + + CCTK_INT ni, nj, nk, gsize, loc_order; + CCTK_REAL delta; + CCTK_INT bb[2]; + int onesided[6]; + int nelements; + + void CCTK_FCALL CCTK_FNAME(deriv2_gf_2_1)(const CCTK_REAL *var, + const CCTK_INT *ni, + const CCTK_INT *nj, + const CCTK_INT *nk, + const CCTK_INT *dir, + const CCTK_INT *bb, + const CCTK_INT *gsize, + const CCTK_REAL *delta, + CCTK_REAL *dvar2); + void CCTK_FCALL CCTK_FNAME(deriv2_gf_4_2)(const CCTK_REAL *var, + const CCTK_INT *ni, + const CCTK_INT *nj, + const CCTK_INT *nk, + const CCTK_INT *dir, + const CCTK_INT *bb, + const CCTK_INT *gsize, + const CCTK_REAL *delta, + CCTK_REAL *dvar2); + + + ni = cctk_lsh[0]; nj = cctk_lsh[1]; nk = cctk_lsh[2]; + + if ( table_handle >=0 ) { + nelements = Util_TableGetInt ( table_handle, &loc_order, "order" ); + if ( nelements == UTIL_ERROR_TABLE_NO_SUCH_KEY ) { + loc_order = order; + } else if ( nelements != 1) { + CCTK_WARN (0, "The options table has an entry \"order\", but it does not have the right properties"); + } + } else { + loc_order = order; + } + + SBP_determine_onesided_stencil (cctkGH, onesided); + + switch(dir) { + case 0: { + delta = CCTK_DELTA_SPACE(0); + bb[0] = onesided[0]; + bb[1] = onesided[1]; + gsize = cctk_nghostzones[0]; + break; + } + case 1: { + delta = CCTK_DELTA_SPACE(1); + bb[0] = onesided[2]; + bb[1] = onesided[3]; + gsize = cctk_nghostzones[1]; + break; + } + case 2: { + delta = CCTK_DELTA_SPACE(2); + bb[0] = onesided[4]; + bb[1] = onesided[5]; + gsize = cctk_nghostzones[2]; + break; + } + default: + CCTK_WARN (0, "Wrong direction specified"); + } + + if ( CCTK_Equals(norm_type,"Diagonal") ) { + switch(loc_order) { + case 2: { + CCTK_FNAME(deriv2_gf_2_1)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar2); + break; + } + case 4: { + CCTK_FNAME(deriv2_gf_4_2)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar2); + break; + } + default: + CCTK_WARN (0, "Unknown 2nd derivative stencil specified"); + } + } else { + switch(loc_order) { + default: + CCTK_WARN (0, "Unknown stencil specified"); + } + } +} diff --git a/src/call_up_derivs.c b/src/call_up_derivs.c index 10607a1..fbae767 100644 --- a/src/call_up_derivs.c +++ b/src/call_up_derivs.c @@ -146,32 +146,6 @@ void DiffUpGv ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, } } } else { - if ( CCTK_Equals(operator_type,"Minimal Bandwidth") ) { - switch(loc_order) { -/* case 4: { - CCTK_FNAME(deriv_gf_4_3)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar); - break; - } - case 6: { - CCTK_FNAME(deriv_gf_6_5)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar); - break; - } */ - default: - CCTK_WARN (0, "Unknown stencil specified"); - } - } else { - switch(loc_order) { -/* case 4: { - CCTK_FNAME(deriv_gf_4_3_opt)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar); - break; - } - case 6: { - CCTK_FNAME(deriv_gf_6_5_opt)(var,&ni,&nj,&nk,&dir,bb,&gsize,&delta,dvar); - break; - } */ - default: - CCTK_WARN (0, "Unknown stencil specified"); - } - } + CCTK_WARN (0, "Upwinding stencils not implemented for non-diagonal operators"); } } diff --git a/src/get_coeffs.c b/src/get_coeffs.c index c2aa224..836ff52 100644 --- a/src/get_coeffs.c +++ b/src/get_coeffs.c @@ -12,51 +12,6 @@ -void CCTK_FCALL CCTK_FNAME(set_coeff_2_1)(const CCTK_INT *nsize, - const CCTK_INT *loc_order, - const CCTK_INT *bb, - const CCTK_INT *gsize, - CCTK_INT *imin, - CCTK_INT *imax, - CCTK_REAL *q); -void CCTK_FCALL CCTK_FNAME(set_coeff_4_2)(const CCTK_INT *nsize, - const CCTK_INT *loc_order, - const CCTK_INT *bb, - const CCTK_INT *gsize, - CCTK_INT *imin, - CCTK_INT *imax, - CCTK_REAL *q); -void CCTK_FCALL CCTK_FNAME(set_coeff_6_3)(const CCTK_INT *nsize, - const CCTK_INT *loc_order, - const CCTK_INT *bb, - const CCTK_INT *gsize, - CCTK_INT *imin, - CCTK_INT *imax, - CCTK_REAL *q); -void CCTK_FCALL CCTK_FNAME(set_coeff_8_4)(const CCTK_INT *nsize, - const CCTK_INT *loc_order, - const CCTK_INT *bb, - const CCTK_INT *gsize, - CCTK_INT *imin, - CCTK_INT *imax, - CCTK_REAL *q); -void CCTK_FCALL CCTK_FNAME(set_coeff_4_3)(const CCTK_INT *nsize, - const CCTK_INT *loc_order, - const CCTK_INT *bb, - const CCTK_INT *gsize, - CCTK_INT *imin, - CCTK_INT *imax, - CCTK_REAL *q); -void CCTK_FCALL CCTK_FNAME(set_coeff_6_5)(const CCTK_INT *nsize, - const CCTK_INT *loc_order, - const CCTK_INT *bb, - const CCTK_INT *gsize, - CCTK_INT *imin, - CCTK_INT *imax, - CCTK_REAL *q); - - - void DiffCoeff ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, const CCTK_INT nsize, CCTK_INT *imin, CCTK_INT *imax, CCTK_REAL *q, const CCTK_INT table_handle ) @@ -66,9 +21,81 @@ void DiffCoeff ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, DECLARE_CCTK_ARGUMENTS CCTK_INT ni, nj, nk, gsize, loc_order; - int nelements; CCTK_INT bb[2]; int onesided[6]; + int nelements; + + void CCTK_FCALL CCTK_FNAME(set_coeff_2_1)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_4_2)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_4_3)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_4_3_opt)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_6_3)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_6_3_opt)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_6_5)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_6_5_opt)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_8_4)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_8_4_opt)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + ni = cctk_lsh[0]; nj = cctk_lsh[1]; nk = cctk_lsh[2]; if ( table_handle >=0 ) { @@ -104,42 +131,80 @@ void DiffCoeff ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, break; } default: - assert(0); + CCTK_WARN (0, "Wrong direction specified"); } if ( CCTK_Equals(norm_type,"Diagonal") ) { - switch(loc_order) { - case 2: { - CCTK_FNAME(set_coeff_2_1)(&nsize,&loc_order,bb,&gsize,imin,imax,q); - break; - } - case 4: { - CCTK_FNAME(set_coeff_4_2)(&nsize,&loc_order,bb,&gsize,imin,imax,q); - break; - } - case 6: { - CCTK_FNAME(set_coeff_6_3)(&nsize,&loc_order,bb,&gsize,imin,imax,q); - break; - } - case 8: { - CCTK_FNAME(set_coeff_8_4)(&nsize,&loc_order,bb,&gsize,imin,imax,q); - break; - } - default: - assert(0); + if ( CCTK_Equals(operator_type,"Minimal Bandwidth") ) { + switch(loc_order) { + case 2: { + CCTK_FNAME(set_coeff_2_1)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 4: { + CCTK_FNAME(set_coeff_4_2)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 6: { + CCTK_FNAME(set_coeff_6_3)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 8: { + CCTK_FNAME(set_coeff_8_4)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown stencil specified"); + } + } else { + switch(loc_order) { + case 2: { + CCTK_FNAME(set_coeff_2_1)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 4: { + CCTK_FNAME(set_coeff_4_2)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 6: { + CCTK_FNAME(set_coeff_6_3_opt)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 8: { + CCTK_FNAME(set_coeff_8_4_opt)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown stencil specified"); + } } } else { - switch(loc_order) { - case 4: { - CCTK_FNAME(set_coeff_4_3)(&nsize,&loc_order,bb,&gsize,imin,imax,q); - break; - } - case 6: { - CCTK_FNAME(set_coeff_6_5)(&nsize,&loc_order,bb,&gsize,imin,imax,q); - break; - } - default: - assert(0); + if ( CCTK_Equals(operator_type,"Minimal Bandwidth") ) { + switch(loc_order) { + case 4: { + CCTK_FNAME(set_coeff_4_3)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 6: { + CCTK_FNAME(set_coeff_6_5)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown stencil specified"); + } + } else { + switch(loc_order) { + case 4: { + CCTK_FNAME(set_coeff_4_3_opt)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 6: { + CCTK_FNAME(set_coeff_6_5_opt)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown stencil specified"); + } } } } diff --git a/src/get_coeffs2.c b/src/get_coeffs2.c new file mode 100644 index 0000000..9d2a0ea --- /dev/null +++ b/src/get_coeffs2.c @@ -0,0 +1,114 @@ +#include <assert.h> +#include <stdio.h> + +#include "cctk.h" +#include "cctk_Parameters.h" +#include "cctk_Arguments.h" + +#include "util_ErrorCodes.h" +#include "util_Table.h" + +#include "stencil.h" + + + +void DiffCoeff2 ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, + const CCTK_INT nsize, CCTK_INT *imin, CCTK_INT *imax, + CCTK_REAL *q, const CCTK_INT table_handle ) +{ + cGH const * restrict const cctkGH = cctkGH_; + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_ARGUMENTS + + CCTK_INT ni, nj, nk, gsize, loc_order; + CCTK_INT bb[2]; + int onesided[6]; + int nelements; + + void CCTK_FCALL CCTK_FNAME(set_coeff2_2_1)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff2_4_2)(const CCTK_INT *nsize, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + + ni = cctk_lsh[0]; nj = cctk_lsh[1]; nk = cctk_lsh[2]; + + if ( table_handle >=0 ) { + nelements = Util_TableGetInt ( table_handle, &loc_order, "order" ); + if ( nelements == UTIL_ERROR_TABLE_NO_SUCH_KEY ) { + loc_order = order; + } else if ( nelements != 1) { + CCTK_WARN (0, "The options table has an entry \"order\", but it does not have the right properties"); + } + } else { + loc_order = order; + } + + SBP_determine_onesided_stencil (cctkGH, onesided); + + switch(dir) { + case 0: { + assert(nsize==ni); + bb[0] = onesided[0]; bb[1] = onesided[1]; + gsize = cctk_nghostzones[0]; + break; + } + case 1: { + assert(nsize==nj); + bb[0] = onesided[2]; bb[1] = onesided[3]; + gsize = cctk_nghostzones[1]; + break; + } + case 2: { + assert(nsize==nk); + bb[0] = onesided[4]; bb[1] = onesided[5]; + gsize = cctk_nghostzones[2]; + break; + } + default: + CCTK_WARN (0, "Wrong direction specified"); + } + + if ( CCTK_Equals(norm_type,"Diagonal") ) { + if ( CCTK_Equals(operator_type,"Minimal Bandwidth") ) { + switch(loc_order) { + case 2: { + CCTK_FNAME(set_coeff2_2_1)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 4: { + CCTK_FNAME(set_coeff2_4_2)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown stencil specified"); + } + } else { + switch(loc_order) { + case 2: { + CCTK_FNAME(set_coeff2_2_1)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 4: { + CCTK_FNAME(set_coeff2_4_2)(&nsize,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown stencil specified"); + } + } + } else { + if ( CCTK_Equals(operator_type,"Minimal Bandwidth") ) { + CCTK_WARN (0, "Unknown stencil specified"); + } + } +} diff --git a/src/get_up_coeffs.c b/src/get_up_coeffs.c new file mode 100644 index 0000000..77226cc --- /dev/null +++ b/src/get_up_coeffs.c @@ -0,0 +1,138 @@ +#include <assert.h> +#include <stdio.h> + +#include "cctk.h" +#include "cctk_Parameters.h" +#include "cctk_Arguments.h" + +#include "util_ErrorCodes.h" +#include "util_Table.h" + +#include "stencil.h" + + + + + +void DiffUpCoeff ( const CCTK_POINTER_TO_CONST cctkGH_, const CCTK_INT dir, + const CCTK_INT nsize, CCTK_INT *imin, CCTK_INT *imax, + CCTK_REAL *q, const CCTK_INT up, const CCTK_INT table_handle ) +{ + cGH const * restrict const cctkGH = cctkGH_; + DECLARE_CCTK_PARAMETERS + DECLARE_CCTK_ARGUMENTS + + CCTK_INT ni, nj, nk, gsize, loc_order; + CCTK_INT bb[2]; + int onesided[6]; + int nelements; + + void CCTK_FCALL CCTK_FNAME(set_coeff_up_2_1)(const CCTK_INT *nsize, + const CCTK_INT *up_dir, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_up_4_2)(const CCTK_INT *nsize, + const CCTK_INT *up_dir, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_up_6_3_opt)(const CCTK_INT *nsize, + const CCTK_INT *up_dir, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + void CCTK_FCALL CCTK_FNAME(set_coeff_up_8_4_opt)(const CCTK_INT *nsize, + const CCTK_INT *up_dir, + const CCTK_INT *loc_order, + const CCTK_INT *bb, + const CCTK_INT *gsize, + CCTK_INT *imin, + CCTK_INT *imax, + CCTK_REAL *q); + + ni = cctk_lsh[0]; nj = cctk_lsh[1]; nk = cctk_lsh[2]; + + if ( table_handle >=0 ) { + nelements = Util_TableGetInt ( table_handle, &loc_order, "order" ); + if ( nelements == UTIL_ERROR_TABLE_NO_SUCH_KEY ) { + loc_order = order; + } else if ( nelements != 1) { + CCTK_WARN (0, "The options table has an entry \"order\", but it does not have the right properties"); + } + } else { + loc_order = order; + } + + SBP_determine_onesided_stencil (cctkGH, onesided); + + switch(dir) { + case 0: { + assert(nsize==ni); + bb[0] = onesided[0]; bb[1] = onesided[1]; + gsize = cctk_nghostzones[0]; + break; + } + case 1: { + assert(nsize==nj); + bb[0] = onesided[2]; bb[1] = onesided[3]; + gsize = cctk_nghostzones[1]; + break; + } + case 2: { + assert(nsize==nk); + bb[0] = onesided[4]; bb[1] = onesided[5]; + gsize = cctk_nghostzones[2]; + break; + } + default: + assert(0); + } + + if ( CCTK_Equals(norm_type,"Diagonal") ) { + if ( CCTK_Equals(operator_type,"Minimal Bandwidth") ) { + switch(loc_order) { + case 2: { + CCTK_FNAME(set_coeff_up_2_1)(&nsize,&up,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 4: { + CCTK_FNAME(set_coeff_up_4_2)(&nsize,&up,&loc_order,bb,&gsize,imin,imax,q); + break; + } + default: + CCTK_WARN (0, "Unknown upwinding stencil specified"); + } + } else { + switch(loc_order) { + case 2: { + CCTK_FNAME(set_coeff_up_2_1)(&nsize,&up,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 4: { + CCTK_FNAME(set_coeff_up_4_2)(&nsize,&up,&loc_order,bb,&gsize,imin,imax,q); + break; + } + case 6: { + CCTK_FNAME(set_coeff_up_6_3_opt)(&nsize,&up,&loc_order,bb,&gsize,imin,imax,q); + } + case 8: { + CCTK_FNAME(set_coeff_up_8_4_opt)(&nsize,&up,&loc_order,bb,&gsize,imin,imax,q); + } + default: + CCTK_WARN (0, "Unknown upwinding stencil specified"); + } + } + } else { + CCTK_WARN (0, "Upwinding stencils not implemented for non-diagonal operators"); + } +} diff --git a/src/make.code.defn b/src/make.code.defn index b9672ed..b5bb131 100644 --- a/src/make.code.defn +++ b/src/make.code.defn @@ -4,9 +4,13 @@ # Source files in this directory SRCS = call_derivs.c \ call_up_derivs.c \ + call_derivs2.c \ call_derivs_name.c \ + All_Coeffs_mod.F90 \ Derivatives_2_1.F90 \ + Derivatives2_2_1.F90 \ Derivatives_4_2.F90 \ + Derivatives2_4_2.F90 \ Derivatives_6_3.F90 \ Derivatives_6_3_min_err_coeff.F90 \ Derivatives_8_4.F90 \ @@ -34,12 +38,20 @@ SRCS = call_derivs.c \ Dissipation_6_5_min_err_coeff_alt.F90 \ dissipation_coeff.F90 \ get_coeffs.c \ + get_up_coeffs.c \ + get_coeffs2.c \ Coefficients_2_1.F90 \ + Coefficients2_2_1.F90 \ Coefficients_4_2.F90 \ + Coefficients2_4_2.F90 \ Coefficients_6_3.F90 \ + Coefficients_6_3_min_err_coeff.F90 \ Coefficients_8_4.F90 \ + Coefficients_8_4_min_err_coeff.F90 \ Coefficients_4_3.F90 \ + Coefficients_4_3_min_err_coeff.F90 \ Coefficients_6_5.F90 \ + Coefficients_6_5_min_err_coeff.F90 \ stencil.c # Subdirectories containing source files diff --git a/src/make.code.deps b/src/make.code.deps new file mode 100644 index 0000000..23655a1 --- /dev/null +++ b/src/make.code.deps @@ -0,0 +1,25 @@ +Derivatives_2_1.o: All_Coeffs_mod.F90.o +Coefficients_2_1.o: All_Coeffs_mod.F90.o +Derivatives2_2_1.o: All_Coeffs_mod.F90.o +Coefficients2_2_1.o: All_Coeffs_mod.F90.o +Derivatives_4_2.o: All_Coeffs_mod.F90.o +Coefficients_4_2.o: All_Coeffs_mod.F90.o +Derivatives2_4_2.o: All_Coeffs_mod.F90.o +Coefficients2_4_2.o: All_Coeffs_mod.F90.o +Derivatives_4_3.o: All_Coeffs_mod.F90.o +Coefficients_4_3.o: All_Coeffs_mod.F90.o +Derivatives_4_3_min_err_coeff.o: All_Coeffs_mod.F90.o +Coefficients_4_3_min_err_coeff.o: All_Coeffs_mod.F90.o +Derivatives_6_3.o: All_Coeffs_mod.F90.o +Coefficients_6_3.o: All_Coeffs_mod.F90.o +Derivatives_6_3_min_err_coeff.o: All_Coeffs_mod.F90.o +Coefficients_6_3_min_err_coeff.o: All_Coeffs_mod.F90.o +Derivatives_6_5.o: All_Coeffs_mod.F90.o +Coefficients_6_5.o: All_Coeffs_mod.F90.o +Derivatives_6_5_min_err_coeff.o: All_Coeffs_mod.F90.o +Coefficients_6_5_min_err_coeff.o: All_Coeffs_mod.F90.o +Derivatives_8_4.o: All_Coeffs_mod.F90.o +Coefficients_8_4.o: All_Coeffs_mod.F90.o +Derivatives_8_4_min_err_coeff.o: All_Coeffs_mod.F90.o +Coefficients_8_4_min_err_coeff.o: All_Coeffs_mod.F90.o + |